summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--tk/ChangeLog2927
-rw-r--r--tk/README404
-rw-r--r--tk/ToDo90
-rw-r--r--tk/changes666
-rw-r--r--tk/compat/limits.h1
-rw-r--r--tk/compat/stdlib.h3
-rw-r--r--tk/compat/unistd.h1
-rwxr-xr-xtk/configure27
-rw-r--r--tk/configure.in2
-rw-r--r--tk/cygtcl.m4310
-rw-r--r--tk/doc/3DBorder.3100
-rw-r--r--tk/doc/AddOption.360
-rw-r--r--tk/doc/BackgdErr.358
-rw-r--r--tk/doc/BindTable.31
-rw-r--r--tk/doc/CanvPsY.33
-rw-r--r--tk/doc/CanvTkwin.31
-rw-r--r--tk/doc/CanvTxtInfo.31
-rw-r--r--tk/doc/Clipboard.31
-rw-r--r--tk/doc/ClrSelect.31
-rw-r--r--tk/doc/ConfigWidg.310
-rw-r--r--tk/doc/ConfigWind.31
-rw-r--r--tk/doc/CoordToWin.31
-rw-r--r--tk/doc/CrtErrHdlr.31
-rw-r--r--tk/doc/CrtGenHdlr.31
-rw-r--r--tk/doc/CrtImgType.341
-rw-r--r--tk/doc/CrtItemType.336
-rw-r--r--tk/doc/CrtPhImgFmt.362
-rw-r--r--tk/doc/CrtSelHdlr.31
-rw-r--r--tk/doc/CrtWindow.33
-rw-r--r--tk/doc/DeleteImg.31
-rw-r--r--tk/doc/DoOneEvent.3108
-rw-r--r--tk/doc/DoWhenIdle.386
-rw-r--r--tk/doc/DrawFocHlt.34
-rw-r--r--tk/doc/EventHndlr.33
-rw-r--r--tk/doc/FindPhoto.311
-rw-r--r--tk/doc/FontId.31
-rw-r--r--tk/doc/FreeXId.33
-rw-r--r--tk/doc/GeomReq.31
-rw-r--r--tk/doc/GetAnchor.349
-rw-r--r--tk/doc/GetBitmap.3135
-rw-r--r--tk/doc/GetCapStyl.31
-rw-r--r--tk/doc/GetClrmap.31
-rw-r--r--tk/doc/GetColor.3153
-rw-r--r--tk/doc/GetCursor.3139
-rw-r--r--tk/doc/GetDash.371
-rw-r--r--tk/doc/GetFont.3109
-rw-r--r--tk/doc/GetFontStr.379
-rw-r--r--tk/doc/GetGC.31
-rw-r--r--tk/doc/GetHINSTANCE.325
-rw-r--r--tk/doc/GetHWND.329
-rw-r--r--tk/doc/GetImage.33
-rw-r--r--tk/doc/GetJoinStl.31
-rw-r--r--tk/doc/GetJustify.353
-rw-r--r--tk/doc/GetOption.31
-rw-r--r--tk/doc/GetPixels.370
-rw-r--r--tk/doc/GetPixmap.31
-rw-r--r--tk/doc/GetRelief.353
-rw-r--r--tk/doc/GetRootCrd.31
-rw-r--r--tk/doc/GetScroll.323
-rw-r--r--tk/doc/GetSelect.31
-rw-r--r--tk/doc/GetUid.31
-rw-r--r--tk/doc/GetVRoot.31
-rw-r--r--tk/doc/GetVisual.31
-rw-r--r--tk/doc/Grab.365
-rw-r--r--tk/doc/HWNDToWindow.330
-rw-r--r--tk/doc/HandleEvent.37
-rw-r--r--tk/doc/IdToWindow.31
-rw-r--r--tk/doc/ImgChanged.31
-rw-r--r--tk/doc/InternAtom.31
-rw-r--r--tk/doc/MainLoop.31
-rw-r--r--tk/doc/MainWin.322
-rw-r--r--tk/doc/MaintGeom.31
-rw-r--r--tk/doc/ManageGeom.31
-rw-r--r--tk/doc/MapWindow.311
-rw-r--r--tk/doc/MeasureChar.354
-rw-r--r--tk/doc/MoveToplev.31
-rw-r--r--tk/doc/Name.31
-rw-r--r--tk/doc/NameOfImg.31
-rw-r--r--tk/doc/Notifier.3537
-rw-r--r--tk/doc/OwnSelect.31
-rw-r--r--tk/doc/ParseArgv.31
-rw-r--r--tk/doc/Preserve.3103
-rw-r--r--tk/doc/QWinEvent.31
-rw-r--r--tk/doc/Restack.31
-rw-r--r--tk/doc/RestrictEv.31
-rw-r--r--tk/doc/SetAppName.31
-rw-r--r--tk/doc/SetClass.31
-rw-r--r--tk/doc/SetGrid.31
-rw-r--r--tk/doc/SetOptions.3503
-rw-r--r--tk/doc/SetVisual.31
-rw-r--r--tk/doc/Sleep.337
-rw-r--r--tk/doc/StrictMotif.31
-rw-r--r--tk/doc/Tcl.n181
-rw-r--r--tk/doc/TextLayout.319
-rw-r--r--tk/doc/TkInitStubs.377
-rw-r--r--tk/doc/Tk_Init.31
-rw-r--r--tk/doc/Tk_Main.31
-rw-r--r--tk/doc/WindowId.319
-rw-r--r--tk/doc/after.n109
-rw-r--r--tk/doc/bell.n1
-rw-r--r--tk/doc/bind.n1
-rw-r--r--tk/doc/bindtags.n1
-rw-r--r--tk/doc/bitmap.n1
-rw-r--r--tk/doc/button.n1
-rw-r--r--tk/doc/canvas.n688
-rw-r--r--tk/doc/checkbutton.n1
-rw-r--r--tk/doc/chooseColor.n1
-rw-r--r--tk/doc/chooseDirectory.n53
-rw-r--r--tk/doc/clipboard.n1
-rw-r--r--tk/doc/colors.n782
-rw-r--r--tk/doc/cursors.n154
-rw-r--r--tk/doc/destroy.n1
-rw-r--r--tk/doc/dialog.n1
-rw-r--r--tk/doc/entry.n113
-rw-r--r--tk/doc/event.n22
-rw-r--r--tk/doc/exit.n28
-rw-r--r--tk/doc/fileevent.n109
-rw-r--r--tk/doc/focus.n1
-rw-r--r--tk/doc/focusNext.n1
-rw-r--r--tk/doc/font.n1
-rw-r--r--tk/doc/frame.n1
-rw-r--r--tk/doc/getOpenFile.n20
-rw-r--r--tk/doc/grab.n1
-rw-r--r--tk/doc/grid.n1
-rw-r--r--tk/doc/image.n1
-rw-r--r--tk/doc/keysyms.n930
-rw-r--r--tk/doc/label.n23
-rw-r--r--tk/doc/listbox.n52
-rw-r--r--tk/doc/loadTk.n1
-rw-r--r--tk/doc/lower.n1
-rw-r--r--tk/doc/man.macros2
-rw-r--r--tk/doc/menu.n8
-rw-r--r--tk/doc/menubar.n1
-rw-r--r--tk/doc/menubutton.n1
-rw-r--r--tk/doc/message.n1
-rw-r--r--tk/doc/messageBox.n5
-rw-r--r--tk/doc/option.n1
-rw-r--r--tk/doc/optionMenu.n1
-rw-r--r--tk/doc/options.n4
-rw-r--r--tk/doc/pack-old.n1
-rw-r--r--tk/doc/pack.n1
-rw-r--r--tk/doc/palette.n1
-rw-r--r--tk/doc/photo.n97
-rw-r--r--tk/doc/place.n1
-rw-r--r--tk/doc/popup.n1
-rw-r--r--tk/doc/radiobutton.n1
-rw-r--r--tk/doc/raise.n1
-rw-r--r--tk/doc/scale.n1
-rw-r--r--tk/doc/scrollbar.n1
-rw-r--r--tk/doc/selection.n23
-rw-r--r--tk/doc/send.n14
-rw-r--r--tk/doc/text.n37
-rw-r--r--tk/doc/tk.n15
-rw-r--r--tk/doc/tkerror.n1
-rw-r--r--tk/doc/tkvars.n1
-rw-r--r--tk/doc/tkwait.n1
-rw-r--r--tk/doc/toplevel.n1
-rw-r--r--tk/doc/update.n48
-rw-r--r--tk/doc/winfo.n1
-rw-r--r--tk/doc/wish.11
-rw-r--r--tk/doc/wm.n24
-rw-r--r--tk/generic/default.h4
-rw-r--r--tk/generic/ks_names.h4
-rw-r--r--tk/generic/patchlevel.h23
-rw-r--r--tk/generic/prolog.ps285
-rw-r--r--tk/generic/tk.decls1215
-rw-r--r--tk/generic/tk.h1058
-rw-r--r--tk/generic/tk3d.c659
-rw-r--r--tk/generic/tk3d.h32
-rw-r--r--tk/generic/tkArgv.c23
-rw-r--r--tk/generic/tkAtom.c1
-rw-r--r--tk/generic/tkBind.c1566
-rw-r--r--tk/generic/tkBitmap.c854
-rw-r--r--tk/generic/tkButton.c1549
-rw-r--r--tk/generic/tkButton.h242
-rw-r--r--tk/generic/tkCanvArc.c841
-rw-r--r--tk/generic/tkCanvBmap.c286
-rw-r--r--tk/generic/tkCanvImg.c303
-rw-r--r--tk/generic/tkCanvLine.c1260
-rw-r--r--tk/generic/tkCanvPoly.c1304
-rw-r--r--tk/generic/tkCanvPs.c1000
-rw-r--r--tk/generic/tkCanvText.c638
-rw-r--r--tk/generic/tkCanvUtil.c1103
-rw-r--r--tk/generic/tkCanvWind.c342
-rw-r--r--tk/generic/tkCanvas.c2933
-rw-r--r--tk/generic/tkCanvas.h56
-rw-r--r--tk/generic/tkClipboard.c24
-rw-r--r--tk/generic/tkCmds.c572
-rw-r--r--tk/generic/tkColor.c650
-rw-r--r--tk/generic/tkColor.h50
-rw-r--r--tk/generic/tkConfig.c2424
-rw-r--r--tk/generic/tkConsole.c270
-rw-r--r--tk/generic/tkCursor.c676
-rw-r--r--tk/generic/tkDecls.h2050
-rw-r--r--tk/generic/tkEntry.c2103
-rw-r--r--tk/generic/tkError.c1
-rw-r--r--tk/generic/tkEvent.c188
-rw-r--r--tk/generic/tkFileFilter.c2
-rw-r--r--tk/generic/tkFileFilter.h1
-rw-r--r--tk/generic/tkFocus.c185
-rw-r--r--tk/generic/tkFont.c1534
-rw-r--r--tk/generic/tkFont.h76
-rw-r--r--tk/generic/tkFrame.c216
-rw-r--r--tk/generic/tkGC.c123
-rw-r--r--tk/generic/tkGeometry.c33
-rw-r--r--tk/generic/tkGet.c188
-rw-r--r--tk/generic/tkGrab.c34
-rw-r--r--tk/generic/tkGrid.c152
-rw-r--r--tk/generic/tkImage.c564
-rw-r--r--tk/generic/tkImgBmap.c242
-rw-r--r--tk/generic/tkImgGIF.c1513
-rw-r--r--tk/generic/tkImgPPM.c27
-rw-r--r--tk/generic/tkImgPhoto.c1104
-rw-r--r--tk/generic/tkImgUtil.c1
-rw-r--r--tk/generic/tkInitScript.h13
-rw-r--r--tk/generic/tkInt.decls1932
-rw-r--r--tk/generic/tkInt.h847
-rw-r--r--tk/generic/tkIntDecls.h1485
-rw-r--r--tk/generic/tkIntPlatDecls.h885
-rw-r--r--tk/generic/tkIntXlibDecls.h1674
-rw-r--r--tk/generic/tkListbox.c2728
-rw-r--r--tk/generic/tkMacWinMenu.c22
-rw-r--r--tk/generic/tkMain.c174
-rw-r--r--tk/generic/tkMenu.c2219
-rw-r--r--tk/generic/tkMenu.h190
-rw-r--r--tk/generic/tkMenuDraw.c280
-rw-r--r--tk/generic/tkMenubutton.c691
-rw-r--r--tk/generic/tkMenubutton.h24
-rw-r--r--tk/generic/tkMessage.c54
-rw-r--r--tk/generic/tkObj.c660
-rw-r--r--tk/generic/tkOldConfig.c1023
-rw-r--r--tk/generic/tkOption.c429
-rw-r--r--tk/generic/tkPack.c50
-rw-r--r--tk/generic/tkPatch.h23
-rw-r--r--tk/generic/tkPlace.c76
-rw-r--r--tk/generic/tkPlatDecls.h208
-rw-r--r--tk/generic/tkPointer.c171
-rw-r--r--tk/generic/tkPort.h1
-rw-r--r--tk/generic/tkRectOval.c604
-rw-r--r--tk/generic/tkScale.c1105
-rw-r--r--tk/generic/tkScale.h93
-rw-r--r--tk/generic/tkScrollbar.c83
-rw-r--r--tk/generic/tkScrollbar.h3
-rw-r--r--tk/generic/tkSelect.c228
-rw-r--r--tk/generic/tkSelect.h18
-rw-r--r--tk/generic/tkSend.c1867
-rw-r--r--tk/generic/tkSquare.c389
-rw-r--r--tk/generic/tkStubImg.c75
-rw-r--r--tk/generic/tkStubInit.c954
-rw-r--r--tk/generic/tkStubLib.c110
-rw-r--r--tk/generic/tkTest.c1414
-rw-r--r--tk/generic/tkText.c531
-rw-r--r--tk/generic/tkText.h215
-rw-r--r--tk/generic/tkTextBTree.c200
-rw-r--r--tk/generic/tkTextDisp.c711
-rw-r--r--tk/generic/tkTextImage.c23
-rw-r--r--tk/generic/tkTextIndex.c615
-rw-r--r--tk/generic/tkTextMark.c21
-rw-r--r--tk/generic/tkTextTag.c77
-rw-r--r--tk/generic/tkTextWind.c27
-rw-r--r--tk/generic/tkTrig.c13
-rw-r--r--tk/generic/tkUtil.c659
-rw-r--r--tk/generic/tkVisual.c10
-rw-r--r--tk/generic/tkWindow.c457
-rw-r--r--tk/generic/tkXId.c495
-rw-r--r--tk/library/bgerror.tcl13
-rw-r--r--tk/library/button.tcl113
-rw-r--r--tk/library/choosedir.tcl264
-rw-r--r--tk/library/clrpick.tcl154
-rw-r--r--tk/library/comdlg.tcl63
-rw-r--r--tk/library/console.tcl90
-rw-r--r--tk/library/demos/README3
-rw-r--r--tk/library/demos/arrow.tcl3
-rw-r--r--tk/library/demos/bind.tcl3
-rw-r--r--tk/library/demos/bitmap.tcl3
-rwxr-xr-xtk/library/demos/browse3
-rw-r--r--tk/library/demos/button.tcl3
-rw-r--r--tk/library/demos/check.tcl3
-rw-r--r--tk/library/demos/clrpick.tcl3
-rw-r--r--tk/library/demos/colors.tcl3
-rw-r--r--tk/library/demos/cscroll.tcl3
-rw-r--r--tk/library/demos/ctext.tcl3
-rw-r--r--tk/library/demos/dialog1.tcl3
-rw-r--r--tk/library/demos/dialog2.tcl3
-rw-r--r--tk/library/demos/entry1.tcl3
-rw-r--r--tk/library/demos/entry2.tcl3
-rw-r--r--tk/library/demos/filebox.tcl3
-rw-r--r--tk/library/demos/floor.tcl3
-rw-r--r--tk/library/demos/form.tcl3
-rwxr-xr-xtk/library/demos/hello3
-rw-r--r--tk/library/demos/hscale.tcl3
-rw-r--r--tk/library/demos/icon.tcl3
-rw-r--r--tk/library/demos/image1.tcl3
-rw-r--r--tk/library/demos/image2.tcl3
-rw-r--r--tk/library/demos/images/mickey.gifbin0 -> 9344 bytes
-rw-r--r--tk/library/demos/items.tcl3
-rwxr-xr-xtk/library/demos/ixset3
-rw-r--r--tk/library/demos/label.tcl3
-rw-r--r--tk/library/demos/menu.tcl3
-rw-r--r--tk/library/demos/menubu.tcl3
-rw-r--r--tk/library/demos/msgbox.tcl3
-rw-r--r--tk/library/demos/plot.tcl3
-rw-r--r--tk/library/demos/puzzle.tcl3
-rw-r--r--tk/library/demos/radio.tcl3
-rwxr-xr-xtk/library/demos/rmt3
-rwxr-xr-xtk/library/demos/rolodex3
-rw-r--r--tk/library/demos/ruler.tcl3
-rw-r--r--tk/library/demos/sayings.tcl3
-rw-r--r--tk/library/demos/search.tcl3
-rwxr-xr-xtk/library/demos/square3
-rw-r--r--tk/library/demos/states.tcl3
-rw-r--r--tk/library/demos/style.tcl3
-rwxr-xr-xtk/library/demos/tcolor3
-rw-r--r--tk/library/demos/text.tcl3
-rwxr-xr-xtk/library/demos/timer3
-rw-r--r--tk/library/demos/twind.tcl3
-rw-r--r--tk/library/demos/vscale.tcl3
-rwxr-xr-xtk/library/demos/widget3
-rw-r--r--tk/library/dialog.tcl81
-rw-r--r--tk/library/entry.tcl55
-rw-r--r--tk/library/focus.tcl41
-rw-r--r--tk/library/folder.gifbin0 -> 79 bytes
-rw-r--r--tk/library/images/README3
-rw-r--r--tk/library/images/logo.eps2091
-rwxr-xr-xtk/library/images/pspbrwse.jbfbin0 -> 35786 bytes
-rw-r--r--tk/library/images/pwrdLogo.eps1897
-rw-r--r--tk/library/images/pwrdLogo100.gifbin4147 -> 1615 bytes
-rw-r--r--tk/library/images/pwrdLogo150.gifbin6809 -> 2489 bytes
-rw-r--r--tk/library/images/pwrdLogo175.gifbin7964 -> 2981 bytes
-rw-r--r--tk/library/images/pwrdLogo200.gifbin8964 -> 3491 bytes
-rw-r--r--tk/library/images/pwrdLogo75.gifbin3189 -> 1171 bytes
-rw-r--r--tk/library/images/tai-ku.gifbin0 -> 5473 bytes
-rw-r--r--tk/library/listbox.tcl83
-rw-r--r--tk/library/menu.tcl359
-rw-r--r--tk/library/msgbox.tcl286
-rw-r--r--tk/library/obsolete.tcl3
-rw-r--r--tk/library/optMenu.tcl3
-rw-r--r--tk/library/palette.tcl27
-rw-r--r--tk/library/safetk.tcl239
-rw-r--r--tk/library/scale.tcl49
-rw-r--r--tk/library/scrlbar.tcl76
-rw-r--r--tk/library/tclIndex39
-rw-r--r--tk/library/tearoff.tcl48
-rw-r--r--tk/library/text.tcl127
-rw-r--r--tk/library/textfile.gifbin0 -> 79 bytes
-rw-r--r--tk/library/tk.tcl253
-rw-r--r--tk/library/tkfbox.tcl884
-rw-r--r--tk/library/updir.xbm9
-rw-r--r--tk/library/xmfbox.tcl631
-rw-r--r--tk/mac/MW_TkHeader.h45
-rw-r--r--tk/mac/MW_TkHeader.pch1
-rw-r--r--tk/mac/MW_TkOldImgHeader.h3
-rw-r--r--tk/mac/MW_TkTestHeader.h7
-rw-r--r--tk/mac/MW_TkTestHeader.pch64
-rw-r--r--tk/mac/README259
-rw-r--r--tk/mac/bugs.doc15
-rw-r--r--tk/mac/tclets.r172
-rw-r--r--tk/mac/tclets.tcl1
-rw-r--r--tk/mac/tkMac.h28
-rw-r--r--tk/mac/tkMacAppInit.c35
-rw-r--r--tk/mac/tkMacAppearanceStubs.c106
-rw-r--r--tk/mac/tkMacApplication.r18
-rw-r--r--tk/mac/tkMacBitmap.c34
-rw-r--r--tk/mac/tkMacButton.c886
-rw-r--r--tk/mac/tkMacClipboard.c33
-rw-r--r--tk/mac/tkMacColor.c30
-rw-r--r--tk/mac/tkMacConfig.c46
-rw-r--r--tk/mac/tkMacCursor.c28
-rw-r--r--tk/mac/tkMacCursors.r1
-rw-r--r--tk/mac/tkMacDefault.h11
-rw-r--r--tk/mac/tkMacDialog.c1432
-rw-r--r--tk/mac/tkMacDraw.c64
-rw-r--r--tk/mac/tkMacEmbed.c5
-rw-r--r--tk/mac/tkMacFont.c2018
-rw-r--r--tk/mac/tkMacHLEvents.c23
-rw-r--r--tk/mac/tkMacInit.c5
-rw-r--r--tk/mac/tkMacInt.h94
-rw-r--r--tk/mac/tkMacKeyboard.c330
-rw-r--r--tk/mac/tkMacLibrary.r11
-rw-r--r--tk/mac/tkMacMDEF.c1
-rw-r--r--tk/mac/tkMacMDEF.r1
-rw-r--r--tk/mac/tkMacMenu.c642
-rw-r--r--tk/mac/tkMacMenu.r1
-rw-r--r--tk/mac/tkMacMenubutton.c29
-rw-r--r--tk/mac/tkMacMenus.c49
-rw-r--r--tk/mac/tkMacPort.h15
-rw-r--r--tk/mac/tkMacProjects.sea.hqx2952
-rw-r--r--tk/mac/tkMacRegion.c2
-rw-r--r--tk/mac/tkMacResource.r26
-rw-r--r--tk/mac/tkMacScale.c210
-rw-r--r--tk/mac/tkMacScrlbr.c26
-rw-r--r--tk/mac/tkMacScrollbar.c1610
-rw-r--r--tk/mac/tkMacSend.c329
-rw-r--r--tk/mac/tkMacShLib.exp5
-rw-r--r--tk/mac/tkMacSubwindows.c18
-rw-r--r--tk/mac/tkMacTest.c2
-rw-r--r--tk/mac/tkMacWindowMgr.c223
-rw-r--r--tk/mac/tkMacWm.c489
-rw-r--r--tk/mac/tkMacXCursors.r1
-rw-r--r--tk/mac/tkMacXStubs.c99
-rw-r--r--tk/tests/README30
-rw-r--r--tk/tests/all.tcl78
-rw-r--r--tk/tests/arc.tcl13
-rw-r--r--tk/tests/bell.test30
-rw-r--r--tk/tests/bevel.tcl13
-rw-r--r--tk/tests/bgerror.test26
-rw-r--r--tk/tests/bind.test241
-rw-r--r--tk/tests/bitmap.test116
-rw-r--r--tk/tests/border.test195
-rw-r--r--tk/tests/bugs.tcl13
-rw-r--r--tk/tests/butGeom.tcl13
-rw-r--r--tk/tests/butGeom2.tcl13
-rw-r--r--tk/tests/button.test389
-rw-r--r--tk/tests/canvImg.test35
-rw-r--r--tk/tests/canvPs.test28
-rw-r--r--tk/tests/canvPsBmap.tcl13
-rw-r--r--tk/tests/canvPsGrph.tcl13
-rw-r--r--tk/tests/canvPsImg.tcl85
-rw-r--r--tk/tests/canvPsText.tcl13
-rw-r--r--tk/tests/canvRect.test37
-rw-r--r--tk/tests/canvText.test60
-rw-r--r--tk/tests/canvWind.test27
-rw-r--r--tk/tests/canvas.test151
-rw-r--r--tk/tests/choosedir.test150
-rw-r--r--tk/tests/clipboard.test26
-rw-r--r--tk/tests/clrpick.test108
-rw-r--r--tk/tests/cmap.tcl13
-rw-r--r--tk/tests/cmds.test26
-rw-r--r--tk/tests/color.test154
-rw-r--r--tk/tests/config.test838
-rw-r--r--tk/tests/cursor.test116
-rw-r--r--tk/tests/defs.tcl1097
-rw-r--r--tk/tests/entry.test489
-rw-r--r--tk/tests/event.test39
-rw-r--r--tk/tests/filebox.test88
-rw-r--r--tk/tests/focus.test216
-rw-r--r--tk/tests/focusTcl.test26
-rw-r--r--tk/tests/font.test868
-rw-r--r--tk/tests/frame.test53
-rw-r--r--tk/tests/geometry.test28
-rw-r--r--tk/tests/get.test97
-rw-r--r--tk/tests/grid.test139
-rw-r--r--tk/tests/id.test27
-rw-r--r--tk/tests/image.test31
-rw-r--r--tk/tests/imgBmap.test26
-rw-r--r--tk/tests/imgPPM.test28
-rw-r--r--tk/tests/imgPhoto.test117
-rw-r--r--tk/tests/listbox.test439
-rw-r--r--tk/tests/macEmbed.test73
-rw-r--r--tk/tests/macFont.test210
-rw-r--r--tk/tests/macMenu.test31
-rw-r--r--tk/tests/macWinMenu.test90
-rw-r--r--tk/tests/macscrollbar.test35
-rw-r--r--tk/tests/main.test30
-rw-r--r--tk/tests/menu.test500
-rw-r--r--tk/tests/menuDraw.test48
-rw-r--r--tk/tests/menubut.test50
-rw-r--r--tk/tests/msgbox.test77
-rw-r--r--tk/tests/obj.test27
-rw-r--r--tk/tests/oldpack.test28
-rw-r--r--tk/tests/option.test40
-rw-r--r--tk/tests/pack.test40
-rw-r--r--tk/tests/place.test27
-rw-r--r--tk/tests/raise.test30
-rw-r--r--tk/tests/safe.test46
-rw-r--r--tk/tests/scale.test74
-rw-r--r--tk/tests/scrollbar.test60
-rw-r--r--tk/tests/select.test48
-rw-r--r--tk/tests/send.test51
-rw-r--r--tk/tests/text.test156
-rw-r--r--tk/tests/textBTree.test28
-rw-r--r--tk/tests/textDisp.test36
-rw-r--r--tk/tests/textImage.test33
-rw-r--r--tk/tests/textIndex.test527
-rw-r--r--tk/tests/textMark.test29
-rw-r--r--tk/tests/textTag.test41
-rw-r--r--tk/tests/textWind.test27
-rw-r--r--tk/tests/tk.test50
-rw-r--r--tk/tests/unixButton.test33
-rw-r--r--tk/tests/unixEmbed.test41
-rw-r--r--tk/tests/unixFont.test66
-rw-r--r--tk/tests/unixMenu.test27
-rw-r--r--tk/tests/unixSelect.test244
-rw-r--r--tk/tests/unixSend.test679
-rw-r--r--tk/tests/unixWm.test146
-rw-r--r--tk/tests/util.test27
-rw-r--r--tk/tests/visual.test26
-rw-r--r--tk/tests/visual_bb.test111
-rw-r--r--tk/tests/winButton.test48
-rw-r--r--tk/tests/winClipboard.test65
-rw-r--r--tk/tests/winDialog.test333
-rw-r--r--tk/tests/winFont.test90
-rw-r--r--tk/tests/winMenu.test354
-rw-r--r--tk/tests/winSend.test428
-rw-r--r--tk/tests/winWm.test71
-rw-r--r--tk/tests/window.test46
-rw-r--r--tk/tests/winfo.test89
-rw-r--r--tk/tests/wm.test674
-rw-r--r--tk/tests/xmfbox.test156
-rw-r--r--tk/unix/ChangeLog30
-rw-r--r--tk/unix/Makefile.in486
-rw-r--r--tk/unix/README62
-rw-r--r--tk/unix/aclocal.m42
-rwxr-xr-xtk/unix/configure3201
-rwxr-xr-xtk/unix/configure.in400
-rwxr-xr-xtk/unix/mkLinks895
-rw-r--r--tk/unix/porting.old324
-rw-r--r--tk/unix/tcl.m41882
-rw-r--r--tk/unix/tkAppInit.c39
-rw-r--r--tk/unix/tkConfig.sh.in26
-rw-r--r--tk/unix/tkUnix.c32
-rw-r--r--tk/unix/tkUnix3d.c92
-rw-r--r--tk/unix/tkUnixButton.c48
-rw-r--r--tk/unix/tkUnixColor.c1
-rw-r--r--tk/unix/tkUnixConfig.c46
-rw-r--r--tk/unix/tkUnixCursor.c18
-rw-r--r--tk/unix/tkUnixDefault.h13
-rw-r--r--tk/unix/tkUnixDialog.c8
-rw-r--r--tk/unix/tkUnixDraw.c37
-rw-r--r--tk/unix/tkUnixEmbed.c60
-rw-r--r--tk/unix/tkUnixEvent.c111
-rw-r--r--tk/unix/tkUnixFocus.c2
-rw-r--r--tk/unix/tkUnixFont.c2788
-rw-r--r--tk/unix/tkUnixInit.c11
-rw-r--r--tk/unix/tkUnixInt.h14
-rw-r--r--tk/unix/tkUnixKey.c355
-rw-r--r--tk/unix/tkUnixMenu.c454
-rw-r--r--tk/unix/tkUnixMenubu.c12
-rw-r--r--tk/unix/tkUnixPort.h8
-rw-r--r--tk/unix/tkUnixScale.c260
-rw-r--r--tk/unix/tkUnixScrlbr.c1
-rw-r--r--tk/unix/tkUnixSelect.c566
-rw-r--r--tk/unix/tkUnixSend.c115
-rw-r--r--tk/unix/tkUnixWm.c458
-rw-r--r--tk/unix/tkUnixXId.c8
-rw-r--r--tk/win/Makefile.in1029
-rw-r--r--tk/win/README119
-rw-r--r--tk/win/aclocal.m42
-rwxr-xr-xtk/win/configure1895
-rwxr-xr-xtk/win/configure.in304
-rw-r--r--tk/win/makefile.vc268
-rw-r--r--tk/win/mkd.bat1
-rw-r--r--tk/win/rc/tk.rc101
-rw-r--r--tk/win/rc/tk_base.rc130
-rw-r--r--tk/win/rc/tk_dll.rc169
-rw-r--r--tk/win/rc/wish.icobin1398 -> 3630 bytes
-rw-r--r--tk/win/rc/wish.rc9
-rw-r--r--tk/win/rc/wish_static.rc177
-rw-r--r--tk/win/rmd.bat1
-rw-r--r--tk/win/stubs.c6
-rw-r--r--tk/win/tcl.m4634
-rw-r--r--tk/win/tkConfig.sh.in92
-rw-r--r--tk/win/tkWin.h14
-rw-r--r--tk/win/tkWin32Dll.c7
-rw-r--r--tk/win/tkWin3d.c98
-rw-r--r--tk/win/tkWinButton.c177
-rw-r--r--tk/win/tkWinClipboard.c249
-rw-r--r--tk/win/tkWinColor.c75
-rw-r--r--tk/win/tkWinConfig.c61
-rw-r--r--tk/win/tkWinCursor.c35
-rw-r--r--tk/win/tkWinDefault.h13
-rw-r--r--tk/win/tkWinDialog.c1981
-rw-r--r--tk/win/tkWinDraw.c253
-rw-r--r--tk/win/tkWinEmbed.c60
-rw-r--r--tk/win/tkWinFont.c2281
-rw-r--r--tk/win/tkWinImage.c5
-rw-r--r--tk/win/tkWinInit.c23
-rw-r--r--tk/win/tkWinInt.h100
-rw-r--r--tk/win/tkWinKey.c648
-rw-r--r--tk/win/tkWinMenu.c1014
-rw-r--r--tk/win/tkWinPixmap.c47
-rw-r--r--tk/win/tkWinPointer.c59
-rw-r--r--tk/win/tkWinPort.h35
-rw-r--r--tk/win/tkWinRegion.c1
-rw-r--r--tk/win/tkWinScrlbr.c34
-rw-r--r--tk/win/tkWinTest.c250
-rw-r--r--tk/win/tkWinWindow.c49
-rw-r--r--tk/win/tkWinWm.c726
-rw-r--r--tk/win/tkWinX.c254
-rw-r--r--tk/win/winDumpExts.c503
-rw-r--r--tk/win/winMain.c160
-rw-r--r--tk/xlib/X11/X.h6
-rw-r--r--tk/xlib/X11/Xlib.h3122
-rw-r--r--tk/xlib/X11/Xutil.h24
-rw-r--r--tk/xlib/xbytes.h1
-rw-r--r--tk/xlib/xcolors.c17
-rw-r--r--tk/xlib/xcolors.h771
-rw-r--r--tk/xlib/xdraw.c1
-rw-r--r--tk/xlib/xgc.c200
-rw-r--r--tk/xlib/ximage.c1
-rw-r--r--tk/xlib/xutil.c1
591 files changed, 105897 insertions, 29641 deletions
diff --git a/tk/ChangeLog b/tk/ChangeLog
index 8fc363a4cb8..25d85457335 100644
--- a/tk/ChangeLog
+++ b/tk/ChangeLog
@@ -1,89 +1,2908 @@
-2000-01-26 DJ Delorie <dj@cygnus.com>
+2001-08-08 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4: Update from Tcl.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+
+2001-08-06 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4: Update from Tcl.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+
+2001-08-06 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Remove TCL_LIB_FLAG, replace TCL_LIB_SPEC
+ with TCL_BUILD_LIB_SPEC.
+ * unix/configure: Regen.
+ * unix/configure.in: Avoid resetting TCL_LIB_SPEC and
+ TCL_STUB_LIB_SPEC since they are already set in tclConfig.sh. Subst
+ TCL_BUILD_STUB_LIB_SPEC and TCL_BUILD_LIB_SPEC into the Makefile.
+ * win/Makefile.in: Use TCL_LIB_SPEC and TCL_STUB_LIB_SPEC from
+ tclConfig.sh instead of creating them via a cygpath call. Use
+ TCL_STUB_LIB_SPEC in place of TCL_STUB_LIB_FILE.
+ * win/configure: Regen.
+ * win/configure.in: Fixup TK_STUB_LIB_SPEC, TK_BUILD_STUB_LIB_PATH,
+ TK_STUB_LIB_PATH, TK_LIB_FLAG, TK_BUILD_LIB_SPEC, TK_LIB_SPEC
+ and TK_LIB_FULL_PATH variables so they work like the unix version.
+
+2001-08-01 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4: Update from Tcl.
+ * unix/configure: Regen.
+ * unix/configure.in: Use TCL_TOOL_SHARED_LIB_LONGNAME
+ and TCL_TOOL_STATIC_LIB_LONGNAME to generate lib names.
+ * win/configure: Regen.
+ * win/configure.in: Use TCL_TOOL_SHARED_LIB_LONGNAME
+ and TCL_TOOL_STATIC_LIB_LONGNAME to generate lib names.
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * generic/default.h: Include tkWinDefault.h
+ when built with Cygwin or Mingw.
+
+2001-07-24 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4: Update from Tcl.
+
+2001-07-12 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in:
+ * unix/configure: Regen.
+ * unix/configure.in:
+ * unix/tcl.m4:
+ * win/Makefile.in:
+ * win/configure: Regen.
+ * win/configure.in:
+ * win/tcl.m4:
+ Revert ill-conceived EXTRA_CFLAGS changes made on 2001-07-09.
+ The change ended up causing big problems with the
+ tclConfig.sh file since it exported EXTRA_CFLAGS and did
+ not deal with the debug/non-debug case.
+
+2001-07-11 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4: Update from Tcl.
+
+2001-07-11 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Add AR and STLIB_LD variables.
+ * unix/configure: Regen.
+ * 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.
+
+2001-07-10 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Use STLIB_LD in MAKE_LIB instead
+ of AR which can be overridden on the make command line.
+
+2001-07-09 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4 (SC_CONFIG_CFLAGS): Fix quoting of CYGPATH
+ argument to AC_CHECK_PROG.
+
+2001-07-09 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Add EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE
+ variables. These two do not actually differ in the unix version
+ but are there to keep in sync with the Windows version.
+ * unix/configure: Regen.
+ * unix/configure.in: Don't subst EXTRA_CFLAGS. Subst EXTRA_CFLAGS_DEFAULT,
+ EXTRA_CFLAGS_DEBUG, and EXTRA_CFLAGS_OPTIMIZE.
+ * unix/tcl.m4: Update from Tcl.
+ * win/Makefile.in: Add EXTRA_CFLAGS_DEBUG and EXTRA_CFLAGS_OPTIMIZE
+ variables. This is needed so that the proper runtime lib gets linked
+ into VC++ produced .obj files when CFLAGS is reset on the command line.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst EXTRA_CFLAGS. Subst EXTRA_CFLAGS_DEFAULT,
+ EXTRA_CFLAGS_DEBUG, and EXTRA_CFLAGS_OPTIMIZE.
+ * win/tcl.m4: Update from Tcl.
+
+2001-07-06 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
+
+2001-07-06 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/configure.in: Replace call to SC_ENABLE_GCC with
+ AC_PROG_CC so that CC passed in from the caller is respected.
+ * unix/tcl.m4: Update from Tcl.
+ * win/configure: Regen.
+ * win/configure.in: Replace call to SC_ENABLE_GCC with
+ AC_PROG_CC so that CC passed in from the caller is respected.
+ * win/tcl.m4: Update from Tcl.
+
+2001-07-06 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Subst DEPARG directly instead
+ of relying on a variable. This will make Cygwin
+ builds faster since an extra exec will be avoided.
+ * win/configure: Regen.
+ * win/configure.in: Subst DEPARG.
+ * win/tcl.m4: Update from Tcl.
+
+2001-06-26 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4: Update from Tcl.
+ * unix/configure: Regen.
+ * win/Makefile.in: Remove PATHTYPE variable.
+ Use : in VPATH instead of VPSEP.
+ * win/configure: Regen.
+ * win/configure.in: Don't subst PATHTYPE or VPSEP.
+ * win/tcl.m4: Update from Tcl.
+
+2001-06-25 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure: Regen.
+ * win/tcl.m4: Update from Tcl.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * 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.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * configure:
+ * configure.in: When a windows32 host is detected
+ configure in the win subdirectory.
+ * cygtcl.m4: Update from Tcl.
+ * unix/configure: Regen.
+ * win/configure: Regen.
+
+2001-06-22 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/tcl.m4: Update from Tcl.
+
+2001-06-08 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Set TK_LIBRARY to
+ $INSTALL/share/tk8.3 instead of
+ $INSTALL/lib/tk8.3.
+
+2001-06-06 Mo DeJong <mdejong@redhat.com>
+
+ * win/configure:
+ * win/configure.in: Handle the --prefix option correctly
+ it should default to /usr/local like the unix version.
+
+2001-06-05 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4:
+ * unix/configure: Update from Tcl.
+
+2001-06-01 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4:
+ * unix/configure:
+ * win/configure:
+ * win/tcl.m4: Update from Tcl.
+
+2001-05-30 Mo DeJong <mdejong@redhat.com>
+
+ * unix/configure: Regen.
+ * unix/tcl.m4:
+ Update from Tcl version.
+
+2001-05-30 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4:
+ * unix/configure: Regen.
+ * unix/tcl.m4:
+ Update from Tcl versions.
+
+2001-05-26 Mo DeJong <mdejong@redhat.com>
+
+ * cygtcl.m4:
+ * unix/aclocal.m4:
+ * unix/configure: Regen.
+ * unix/tcl.m4:
+ * win/aclocal.m4:
+ * win/configure: Regen.
+ * win/tcl.m4:
+ Update from Tcl versions.
+
+2001-05-09 Mo DeJong <mdejong@redhat.com>
+
+ * unix/Makefile.in: Use TK_STUB_LIB_FILE instead
+ of STUB_LIB_FILE subst.
+ * unix/configure: Regen.
+ * unix/configure.in: Use new path macros.
+ * unix/tcl.m4: Update from Tcl.
+ * win/configure: Regen.
+ * win/configure.in: Use new path macros.
+ * win/tcl.m4: Update from Tcl.
- * win/tkWin32Dll.c (DllMain): Use _imp__ instead of __imp_
+2001-05-08 Ian Roxborough <irox@redhat.com>
-1999-03-02 James Ingham <jingham@cygnus.com>
+ * unix/configure.in: Cygnus local change
+ to build gdbtk: Set TK_BUILD_INCLUDES to
+ correct path.
+ * unix/configure: Regenerated.
+
+2001-04-09 Mo DeJong <mdejong@redhat.com>
+
+ * unix/aclocal.m4: Pull in tcl.m4.
+ * unix/configure: Regen.
+ * unix/tcl.m4: Add from tcl/unix.
+ * win/Makefile.in: Append version to tclsh
+ in the win subdirectory.
+ * win/configure: Regen.
+ * win/configure.in: The TK_BUILD_LIB_SPEC and
+ TK_BUILD_LIB_SPEC variables need to use the
+ lib file and not the dll file, since it is
+ not possible to link to a dll with VC++.
+ Use new TCL_TOOL_PATH macro to correctly
+ set the XINCLUDES variable.
+ * win/tcl.m4: Update from tcl/win so we can use
+ the TCL_TOOL_PATH macro.
+
+2001-04-05 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in: Don't depend on
+ TCLSH_PROG variable from configure.
+ * win/configure: Regen.
+ * win/configure.in: Don't call
+ SC_PROG_TCLSH, it was removed from
+ Tcl. This macro required that Tcl
+ be built before Tk could be configured.
+ * win/tcl.m4: Update from Tcl version.
+
+2000-08-08 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ 8.3.2 RELEASE finalized
+
+ * changes: updated for release notes version of ChangeLog
+
+2000-08-05 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * win/Makefile.in (cat32.${OBJEXT}): corrected where to find cat.c
+ given the change in default def'n of TCL_SRC_DIR.
+
+ * win/tcl.m4: changed references from 8.4 to 8.3 (leftover from a
+ backported file).
+
+ * library/safetk.tcl: rationalized the setting of tk_library when
+ initialized Tk in a safe interpreter.
+
+2000-08-04 Jeff Hobbs <hobbs@ajubasolutions.com>
+
+ * BACKPORTED FROM 8.4 (HEAD) BRANCH:
+
+ * tests/button.test:
+ * generic/tkButton.c: Added -activeforeground, -activebackground
+ for labels, for the -state option.
+
+ * doc/label.n: Added -disabledforeground to list of options [Bug:
+ 6053].
+
+ * 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]
+
+ * generic/tkCursor.c: Added initialization for nextPtr field of
+ TkCursor, patch from Nijtmans/Howlett.
+
+ * canvas.test: added test for 5783.
+ * generic/tkCanvPoly.c (DisplayPolygon): added checks for the
+ polygon fillGC not being empty to prevent segfault. [Bug: 5783]
+
+ * generic/tkImgGIF.c: Applied patch from Jan Nijtmans to fix a
+ problem with the GIF writing code [Bug: 5823].
+ * 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.
+
+ * generic/tkMenu.c (DeleteMenuCloneEntries): Applied fix from
+ [Bug: 5275], which corrected a segfault-causing indexing problem
+ when deleting entries from torn-off menus.
+
+ * generic/tkPlace.c (Tk_PlaceCmd): reworked place master/slave
+ table init'n to prevent seg fault when using place on multiple
+ displays.
+
+ * tests/text.test: Added tests for -regexp -nocase searches with
+ backslash character classes.
+ * tests/text.test: Added tests for searching when text is elided.
+ * 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].
+ * 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].
+ * generic/tkText.c (TextSearchCmd): Added a test for a NULL
+ segment pointer when doing backwards searches for "" on an empty
+ text widget. [Bug: 6007].
+
+ * library/focus.tcl: fixed calling of takeFocus proc [Bug: 5372]
+
+ * 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].
+ * 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].
+ * 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-07-20 Brent Welch <welch@ajubasolutions.com>
+
+ * win/tkConfig.sh.in:
+ Made corresponding changes to match gcc for windows mods
+ to the rest of the files.
+
+2000-07-28 Mo DeJong <mdejong@redhat.com>
+
+ * win/Makefile.in:
+ * win/aclocal.m4:
+ * win/configure.in:
+ * win/tcl.m4: Back port of gcc for windows
+ build system from 8.4.
+
+2000-07-26 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/configure.in (TK_PATCH_LEVEL): updated to 8.3.2
+ * unix/tk.spec:
+ * win/configure.in:
+ * generic/tk.h:
+ * README:
+
+2000-07-22 Brent Welch <welch@ajubasolutions.com>
+ * win/Makefile.in, win/configure.in, win/rc/tk.rc, win/rc/tk_base.rc
+ Trying to generalize .rc files so they work with both DLL's and
+ static shell builds.
+
+2000-07-10 Brent Welch <welch@ajubasolutions.com>
+
+ * win/{Makefile.in,configure.in,tkConfig.sh.in}:
+ Cleanup of defines in tkConfig.sh
+
+2000-05-15 Jeff Hobbs <hobbs@scriptics.com>
+
+ * win/tkWinWm.c: changed wm deiconify from using idle
+ callback to calling restack and focus code immediately.
+
+2000-04-26 Jeff Hobbs <hobbs@scriptics.com>
+
+ 8.3.1 RELEASE
+
+ * README:
+ * mac/README:
+ * unix/README:
+ * unix/tk.spec:
+ * win/README: Updating URLs to reference dev.scriptics.com
+
+2000-04-25 Jeff Hobbs <hobbs@scriptics.com>
+
+ * unix/Makefile.in:
+ * win/Makefile.in: makefile cleanup
+
+2000-04-25 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkMain.c: Fixed function header comment for Tk_MainEx.
+
+ * unix/mkLinks:
+ * doc/GetScroll.3: Added information about Tk_GetScrollInfoObj
+ [Bug: 1866].
+
+2000-04-24 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/Grab.3: Man page for Tk_Grab and Tk_Ungrab [Bug: 1868, 1889]
+
+ * unix/mkLinks:
+ * doc/MainWin.3: Added entry for Tk_GetNumMainWindows [Bug: 1865].
+
+ * unix/mkLinks:
+ * doc/GetHINSTANCE.3: Man page for Tk_GetHINSTANCE [Bug: 1862].
+
+2000-04-24 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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
+
+ * generic/tkConfig.c (DoObjConfig): removed direct setting of
+ interp->result.
+
+ * mac/tkMacWm.c (Tk_WmCmd): initialized gotToplevel in
+ colormapwindows case (bug found by Reasoning, Inc's automated code
+ testing).
+
+2000-04-24 Eric Melski <ericm@scriptics.com>
+
+ * unix/mkLinks:
+ * doc/GetHWND.3: Man page for Tk_GetHWND [Bug: 1863].
+
+ * unix/mkLinks:
+ * doc/HWNDToWindow.3: Man page for Tk_HWNDToWindow [Bug: 1869].
+
+ * unix/mkLinks:
+ * doc/AddOption.3: Man page for Tk_AddOption [Bug: 1854]
+
+2000-04-22 Jim Ingham <jingham@cygnus.com>
+
+ * mac/tkMacDialog.c (Tk_MacGetOpenFile): Add empty bodies for the
+ "-initialfile" and "-defaultextension" options.
+
+ * mac/tkMacDialog.c (NavServicesGetFile): Only cons the result up
+ into a list if multiple is true.
+
+ * 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.
+
+ * 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.
+
+2000-04-19 Eric Melski <ericm@scriptics.com>
+
+ * doc/WinViewable.3:
+ * unix/mkLinks: Removed docs for Tk_IsViewable.
+
+ * win/tkWinDialog.c: Removed calls to Tk_IsViewable.
+
+ * generic/tkUtil.c:
+ * generic/tkStubInit.c:
+ * generic/tkDecls.h:
+ * generic/tkCmds.c:
+ * generic/tk.decls: Removed Tk_IsViewable function (it was not
+ actually needed).
+
+2000-04-19 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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
+
+ * library/msgbox.tcl (tkMessageBox): changed to use grid in some
+ places, realign icon to anchor nw.
+
+ * mac/tkMacScale.c: reverted tkMacScale.c to 1.5 equivalent (it
+ was accidentally bumped forward).
+
+2000-04-18 Eric Melski <ericm@scriptics.com>
+
+ * win/tkWinPointer.c: Changed Mod2Mask in TkWinGetModifierState to
+ ALT_MASK, to fix some event problems [Bugs: 1160, 5088].
+
+ * win/tkWinX.c: Changed Mod2Mask in GetState to ALT_MASK, to fix
+ some event problems [Bugs: 1160, 5088].
+
+ * generic/tkInt.h: Moved definition of ALT_MASK and META_MASK here
+ so that it would be accessible from other modules than tkBind.c.
+
+ * 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].
+
+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].
- Copying over irox's 3D changes from Tk8.1 for a more Win95 look.
- The button changes don't seem to work, so I will leave them out
- for now.
+ * 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.
- * win/tkWin3d.c (Tk_3DVerticalBevel, Tk_3DHorizontalBevel): The
- dark pixels are drawn inside the bevel, not outside.
+ * 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].
-Fri Feb 26 17:40:55 1999 Geoffrey Noer <noer@cygnus.com>
+2000-04-16 Jeff Hobbs <hobbs@scriptics.com>
- * win/configure.in: change "cygwin32*" to "cygwin*"
- * win/configure: Regenerated.
- * configure.in: Change "cygwin32*" to "cygwin*"
- * configure: Regenerate.
+ * win/tkWinColor.c (FindSystemColor): correct calculation of
+ colors when shifting value. [Bug: 4919]
-1999-02-11 Syd Polk <spolk@cygnus.com>
+2000-04-16 Jim Ingham <jingham@cygnus.com>
- * unix/configure.in: Forgot to AC_SUBST TK_LIB_FULL_PATH.
- * unix/configure: Regenerate.
+ * mac/tkMacPort.h: protect against strncasecmp already defined -
+ it is in the Pro5 version of MSL.
+
+ * 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.
+
+ * 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.
+
+ * mac/tkMacDialog.c: Pretty substantial rewrite to include
+ Navigation Services support for systems which have it.
+
+2000-04-14 Eric Melski <ericm@scriptics.com>
+
+ * win/tkWinKey.c: Added check for ASCII delete character in
+ KeycodeToKeysym, to fix [Bug: 5090]. See comment in code for more
+ information.
+
+ * generic/ks_names.h: Added Scroll_Lock and Sys_Req definitions.
+
+ * 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.
+
+2000-04-14 Jeff Hobbs <hobbs@scriptics.com>
+
+ * 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]
+
+ * generic/tkCanvas.c (CanvasEventProc:2451): corrected cast
+
+ * generic/tkEntry.c (Tk_EntryObjCmd): adjusted finishing error
+ cases and changed TK_CONFIG_NULL_OK to TK_OPTION_NULL_OK
+
+ * 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]
+
+ * library/scale.tcl (tkScaleActivate): reduced number of scale
+ redisplays by checking current value of state before setting it
+ again. [Bug: 4191]
+
+ * 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>
-1999-02-10 Syd Polk <spolk@cygnus.com>
+ * changes: updated changes file
- * unix/configure.in unix/tkConfig.sh.in: Export TK_LIB_FULL_PATH.
+ * 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]
+
+ * doc/MeasureChar.3: fixed docs for Tk_MeasureChars to reflect code
+ * doc/listbox.n: fixed formatting problem
+
+ * generic/tk3d.c: added extra calculations to ensure that thin
+ frames get refreshed too [Bug: 3596]
+
+ * 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.
+
+ * mac/tclMacHLEvents.c: fixed applescript for I18N [Bug: 3644]
+
+ * 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:
+ * */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/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.
+
+1999-07-29 <redman@scriptics.com>
+
+ * 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]
+
+ * 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.
+
+1999-07-22 <redman@scriptics.com>
+
+ * Changed version to 8.2b2
+
+ * 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:
+ * generic/tkDecls.h:
+ * generic/tkIntDecls.h:
+ * generic/tkIntPlatDecls.h:
+ * generic/tkPlatDecls.h:
+ * generic/tkIntXlibDecls.h: Removed stub functions. Always use the
+ Tcl stubs when building with --enable-shared.
+
+
+1999-03-26 <redman@scriptics.com>
+
+ * generic/tkTextIndex.c:
+ * tests/testIndex.test: Avoid looking past the beginning of the
+ array storing data for the text widget (.t index end-2c). Added
+ test case to check for the bug. [Bug 991]
+
+ * generic/tkConsole.c: Copy static strings into a Tcl_DString
+ before passing to Tcl_Eval, in case the compiler puts static
+ strings into read-only memory.
+
+1999-03-26 <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.
+
+1999-03-26 <surles@scriptics.com>
+
+ * library/menu.tcl: Fixed bug reported by Bryan Oakley in the
+ menubutton bindings. There was a false assumption that there was
+ always a menu attached to the button. [Bug 1116]
+
+1999-03-26 <redman@scriptics.com>
+
+ * unix/configure.in: Removed --enable-tcl-stub. Linking Tk to Tcl
+ stubs is causing too many problems when linking executables like wish.
+ Until the Tk is a fully loadable extension, linking against the Tcl
+ stubs is not supported in Tk.
+
+1999-03-19 <redman@scriptics.com>
+
+ * generic/tkBitmap.c:
+ * generic/tkCursor.c:
+ * generic/tkGC.c: When creating hash tables that key off of XID
+ handles, make sure to pass TCL_ONE_WORD_KEYS. XIDs are guaranteed
+ to be 32bit numbers, although on some 64bit systems (including 64bit
+ Solaris 7) they are packed into a 64bit value where the upper 32bits
+ are zero. The normal method of sizeof(XID)/sizeof(int) causes the
+ hash table code to assume that the XID is a pointer to an array of
+ two ints, which it is not. Tk now supports 64bit Solaris 7.
+
+1999-03-17 <stanton@scriptics.com>
+
+ * win/makefile.vc:
+ * generic/tk.h: Changed to use TCL_BETA_RELEASE macro, and fixed
+ so this works in rc files.
+
+ * win/makefile.vc:
+ * win/makefile.bc:
+ * win/README:
+ * unix/configure.in:
+ * generic/tk.h:
+ * README: Updated version to 8.1b3.
+
+1999-03-14 <stanton@GASPODE>
+
+ * unix/configure.in: Added missing stub related definitions.
+
+ * unix/Makefile.in: Install tkDecls.h in addition to tk.h.
+
+ * generic/tkStubLib.c: Added flags to ensure we are using Tcl
+ stub macros.
+
+1999-03-11 <stanton@GASPODE>
+
+ * generic/tkInt.decls: Added reserved slot for XSetDashes for use
+ by the dash patch.
+
+1999-03-10 <redman@scriptics.com>
+
+ * 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>
+
+ * win/tkWinWm.c: Toplevel class no longer shared between
+ threads.
+
+ * win/tkWinX.c: Multiple threads no longer share the same
+ TkDisplay structure. Required because TkDisplay stores much
+ thread-specific data for a given thread.
+
+ * win/tkWinSend.c: Moved application instance handle out
+ out thread-local storage. DDE was failing to initialize
+ when the instance handles were different between threads.
+
+ * win/makefile.vc: Added THREADDEFINES for building with
+ threads enabled.
+
+ * generic/tkMenu.c:
+ * win/tkWinMenu.c:
+ * unix/tkUnixMenu.c: Added TkpMenuThreadInit for initializing
+ thread-specific Menu state.
+
+1999-03-01 <redman@scriptics.com>
+
+ * win/tkWinWm.c:
+ * win/tkWinPointer.c:
+ * win/tkWinInt.h: Fix "focus -force" for Windows. The Win32 API
+ function SetForegroundWindow() does not work unless the window
+ handle is a toplevel window (a Windows toplevel). The handle
+ being passed was a Tk toplevel, which is a child of the Windows
+ toplevel.
+
+1999-02-26 <redman@scriptics.com>
+
+ * win/cat.c: Remove this file, use the one in the Tcl source directory.
+
+ * win/makefile.vc: Remove the wishc.exe from the default targets. Add
+ a separate console-wish target to build it. The need for a
+ console-wish will go away soon, so we don't want to encourage its
+ use.
+
+1999-02-25 <redman@scriptics.com>
+
+ * win/tkWinWm.c: Properly initialize the tsdPtr->firstWindow field.
+
+ * win/cat.c: Code for cat32.exe, copied from the Tcl sources. Required
+ in order to run the test suite from the makefile
+
+ * win/winMain.c: Add main() for a console-based wishc.exe, which meant
+ adding code to disable the call to Tk_ConsoleInit().
+
+ * generic/tkConsole.c: Check the standard handles before creating the
+ new standard channels. This allows a windows app that has stdin,
+ stdout, or stderr to correctly connect to them.
+
+ * generic/tkMain.c: Add a proper check for the interactive mode, since
+ the standard channels may actually be connected in windows mode or
+ even in the console-based wish.
+
+ * win/makefile.vc: Add targets for wishc.exe (console-based wish) and
+ cat32.exe (for testing). Fix the test suite target so it can be run
+ from the makefile (which can happen since the standard handles have
+ been fixed).
+
+1999-02-12 <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
+
+
+ * generic/tk.h:
+ * generic/tkScale.h:
+ * generic/tkScale.c:
+ * generic/tkWindow.c:
+ * unix/tkUnixScale.c:
+ * unix/tkUnixDefault.h:
+ * unix/tkWinDefault.h:
+ * mac/tkMacDefault.h: Objectified scale widget.
+
+ * win/tkWinX.c: Removed Thread-specific data from process
+ initialization code that was stopping the Tk Dll from
+ loading.
+
+1999-02-11 <stanton@GASPODE>
+
+ * README:
+ * generic/tk.h:
+ * unix/configure.in:
+ * win/README:
+ * win/makefile.bc:
+ * win/makefile.vc: Updated version to 8.1b2.
+
+ * unix/tkUnixSend.c: Fixed one more Tcl_*ObjVar instance.
+
+1999-02-04 <stanton@GASPODE>
+
+ * Various cleanup related to the Tcl_Eval and Tcl_ObjSetVar
+ changes in Tcl.
+
+ INTEGRATED PATCHES FROM 8.0.5b2:
+
+ * win/tkWinMenu.c (TkpDestroyMenu): Changed so modalMenuPtr is
+ cleared when it is being destroyed.
+
+ * generic/tkImgPhoto.c: Changed so color tables are freed
+ immediately instead of being delayed. This ensures that color
+ tables are properly disposed at process exit.
+
+ * library/prolog.ps: Changed string that determines font height to
+ include European character with an umlaut.
+
+ * generic/tkImgBmap.c (ImgBmapConfigureInstance): If an image
+ mask changed but ended up with the same XID, the GC failed to be
+ updated and so the new mask was not used. [Bug: 970]
+
+ * generic/tkFocus.c (SetFocus): Changed so focus window is always
+ set if -force is specified. This fixes the problem on Windows
+ where Tk does not activate the window if it already has focus.
+
+ * generic/tkConsole.c: Fixed so errors in console eval are
+ reported properly. Eliminated duplicate result messages. [Bug: 973]
+
+ * win/tkWinWm.c: Changed so windows that aren't resizable don't
+ have resize handles and the zoom box is disabled.
+
+ * win/tkWinInt.h:
+ * win/tkWinPointer.c: Changed to cancel the mouse timer when a
+ user initiated move/resize loop begins.
+
+ * unix/configure.in: TK_LD_SEARCH_FLAGS was set incorrectly if
+ SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through
+ the C compiler. Systems affected are Linux, MP-RAS and NEXTSTEP,
+ but also with gcc on many more systems. [Bug: 908]
+
+ * win/makefile.vc: First stab at install target. Fixed quoting so
+ paths with spaces work.
+
+ * tests/main.test:
+ * tests/unixWm.test: Better cleanup of temporary files.
+
+ * mac/tkMacAppInit.c:
+ * generic/tkTest.c:
+ * generic/tkAppInit.c:
+ * win/winMain.c: Changed some EXTERN declarations to extern
+ since they are not defining exported interfaces. This avoids
+ generating useless declspec() attributes and makes the windows
+ makefile simpler.
+
+ * library/menu.tcl (tkMenuFind): Changed so keyboard shortcuts
+ will only be found in the current toplevel. Previously, they
+ might be found in menus attached to other toplevels that might not
+ even be mapped. [Bug: 924]
+
+ * generic/tkCanvLine.c: Changed to treat zero width lines like
+ they have width 1 for purposes of selection. [Bug: 925]
+
+ * win/tkWinFont.c (Tk_MeasureChars): Added a workaround for a bug
+ in GetTextExtentExPoint on Win NT 4.0/Japanese. [Bug: 1006]
+
+ * unix/tkUnixSend.c (Tk_SetAppName): Fixed uninitialized memory
+ access bug. [Bug: 919]
+
+1999-1-28 <stanton@GASPODE>
+
+ * generic/tkGrid.c: Fixed bug in "grid forget" that failed to cancel
+ pending idle handlers, resulting in a crash in a few odd cases.
+
+1999-01-06 <lfb@JUSTICE>
+
+ * generic/tk.h, generic/tkGet.c, generic/tkConfig.c,
+ * generic/tkOldConfig.c, generic/tkEntry.c, generic/tkMenubutton.c,
+ * generic/tkMenubutton.h, generic/tkScale.c, generic/tkScale.h,
+ * generic/tkTextDisplay.c, generic/tkText.c, unix/tkUnixMenubu.c,
+ * unix/tkUnixScale.c, mac/tkMacMenu.c, mac/tkMacMenubutton.c,
+
+ Removed global Tk_Uids dealing with "-state" configuration option
+ and added new TK_CONFIG_STATE configSpec that doesn't use
+ Tk_Uids.
+
+1998-12-11 === Tk 8.1b1 Release ===
+
+1998-12-11 <stanton@GASPODE>
+
+ * generic/tkMain.c (Tk_Main): Fixed improper command line encoding
+ handling.
+
+1998-12-08 <stanton@GASPODE>
+
+ * 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]
+
+2000-03-21 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Compare to cygwin, not cygwin32.
+ * configure: Regenerate.
+
+1999-05-24 Syd Polk <spolk@cygnus.com>
+
+ * generic/tkArgv.c: Updated version string.
+
+1999-04-22 Syd Polk <spolk@cygnus.com>
+
+ * unix/Makefile.in: Don't install tk.h for install-libraries.
+
+1999-03-19 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tkfbox.tcl (tkFDialog_OkCmd): Bug fix for double-click on
+ a directory when multiple-mode is turned on, double-clicking a
+ directory didn't switch to that directory.
+
+1999-03-19 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * win/tkWinDialog.c (GetFileName): set the multi flag to the boolean
+ value it was given to turn multi-selection on/off.
+
+ * library/tkfbox.tcl (tkFDialog): mask list of selected files using the
+ list command only when the string isn't empty to avoid getting "{}"
+ in the entry box.
+
+1999-03-19 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tkfbox.tcl (tkFDialog): Corrected reference to not valid
+ variable name.
+
+ * win/tkWinDialog.c (GetFileName): set the multi flag to the boolean
+ value it was given to turn multi-selection on/off.
+
+1999-03-18 Syd Polk <spolk@cygnus.com>
+
+ * library/tkfbox.txl (tkFDialog): Fix a reference to an unknown
+ variable $text.
+
+1999-03-18 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * win/tkWinDialog.c (GetFileName): When only one file is selected and
+ multi selection is enabled, add the file using tcl_AppendElement to the
+ result to get a list of files (here with only one file). This makes
+ the functionality consistent to the case when multiple files are
+ selected. This has produced a bug when only one file is selected that
+ contains spaces.
+
+ * library/tkfbox.tcl (tkFDialog): mask a file containing spaces using
+ the list command when -multipl flag is set to yes.
+ (tkFDialog_ListBrowse): likewise.
+
+1999-03-03 Syd Polk <spolk@cygnus.com>
+
+ * generic/tkText.c (TextSearchCmd): Was incorrectly returning
+ number of bytes instead of number of characters in search subcommand.
+
+1999-03-04 Syd Polk <spolk@cygnus.com>
+
+ * win/tkWinMenu.c: Fixed compile error introduced by merge
+ of 1999-03-02.
+
+1999-02-28 Ian Roxborough <irox@cygnus.com>
+
+ * win/tkWin3d(Tk_3DHorizontalBevel,Tk_3DVerticalBevel):
+ Draw sunken 3D effect the same as Window95/98/NT.
+ * win/tkWinButton: Decrease this minimum button high
+ for a better Windowz look and feel.
+ * win/tkWinDefault.h: Increase default button y padding.
+
+1999-02-22 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Fix TK_LIB_FULL_PATH for cygwin build.
+ * win/configure: Regenerate.
+
+1999-02-18 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Set TK_SRC_DIR and export it.
+ Set TK_LIB_FULL_PATH and export it.
+ * win/configure: Regenerate.
+
+1999-02-09 Syd Polk <spolk@cygnus.com>
+
+ * unix/configure.in: Export TK_LIB_FULL_PATH so that dependency
+ tracking can be done.
+ Use TCL_LIB_FULL_PATH to track dependencies.
* unix/configure: Regenerate.
+ * unix/tkConfig.sh.in: Export TK_LIB_FULL_PATH so that dependecy
+ tracking can be done.
+ * unix/Makefile.in: Add dependency for TCL_LIB_FULL_PATH.
+
+1998-12-31 Syd Polk <spolk@cygnus.com>
+
+ * generic/tkFont.c (Tk_UnderlineTextLayout):
+ Don't draw an underline if underline value is
+ -1.
+
+1998-12-30 Syd Polk <spolk@cygnus.com>
+
+ * generic/tkFont.c (Tk_UnderlineTextLayout):
+ Tk_CharBBox needs a byte offset, not a character
+ offset.
+
+1998-12-17 Syd Polk <spolk@cygnus.com>
+
+ * win/tkWinMenu.c: (TkWinMenuHandleEvent): WM_MENUCHAR
+ needs to index characters, not bytes, when handling the
+ underline character.
+
+1998-12-11 Syd Polk <spolk@cygnus.com>
+
+ * generic/tkMain.c (Tk_Main): All arguments except the filename
+ on the command-line were not being translated to UTF.
+
+1998-12-10 Ian Roxborough <irox@cygnus.com>
-1999-01-29 James Ingham <jingham@cygnus.com>
+ * win/tkWinDialog.c (GetFileName): Increased the buffer size in the
+ file select dialog so that there is less change of it filling up
+ if the user selects a lot of files.
- * win/configure.in: Fill in the XINCLUDE symbol.
- * win/configure: regenerate.
+1998-12-04 Syd Polk <spolk@cygnus.com>
-Mon Jan 11 10:57:05 1999 Jim Ingham <jingham@cygnus.com>
+ * win/tkWinClipboard.c: The clipboard was not translating to
+ and from the Windows character set.
- * win/tkTextDisp.c (tkTextSeeCmd): This is only a workaround for
- a bug somewhere in Tk. If you change the font for the gdbtk
- debug window the see command that follows the report of the
- destruction of the preferences window will return a NULL from
- FindDLine. This should not happen, but I can't find a simple
- case that shows the behavior, and have not taken the time to
- chase it all the way down. This fix makes the error harmless.
+1998-12-03 Ian Roxborough <irox@cygnus.com>
-Thu Dec 17 10:43:53 1998 Jim Ingham <jingham@cygnus.com>
+ * win/tkWinInit.c: Merged in changes from WishCon.
+ * win/tkMain.c: Merged in changes from WishCon.
- * win/tkWinFont.c (Tk_MeasureChar): Add dummy max argument and
- bogus (infinte) maxLength to second call to
- GetTextExtentExPoint to work around a bug in NT/J 4.0 service
- pack 3 or less.
+1998-11-18 Syd Polk <spolk@cygnus.com>
+ * generic/tkMenu.c (ConfigureMenuCloneEntries): The parameter for
+ the configure command when reconfiguring entries for a clone menu
+ should have been "-menu", not "menu".
-Thu Dec 3 12:34:18 1998 Jim Ingham jingham@cygnus.com
+1998-11-19 Ben Elliston <bje@cygnus.com>
- * library/tkfbox.tcl (tkIconListInvoke): Fixed a merge goof
- that was preventing double-clicking in the file dialog from
- working.
+ * win/tkWinWm.c: Local grabs did not exclude menus or the caption
+ bar. `wm frame' would crash if the window had not been mapped yet.
+ Patch obtained from the Scriptics CVS repository.
-Tue Nov 24 18:27:40 1998 Jim Ingham jingham@cygnus.com
+ * win/tkWinWindow.c: Reduce message traffic by setting
+ WS_EX_NOPARENTNOTIFY on TkChild windows. Patch obtained from the
+ Scriptics CVS repository.
- * Import of Tk 8.0.4 from Scriptics.
+1998-11-13 Khamis Abuelkomboz <khamis@cygnus.com>
-Thu Aug 20 14:32:59 1998 Jim Ingham jingham@cygnus.com
+ * generic/tkMenu.c (MenuWidgetObjCmd): added patch for selection
+ problem. Disabled menu entries remain disabled.
+ (DestroyMenuEntry): added patch for memory leak.
- * Import of Tk 8.0.3 from Scriptics, with our modifications.
+1998-11-11 Syd Polk <spolk@cygnus.com>
-Thu Aug 20 18:14:43 1998 Khamis Abuelkomboz <khamis@cygnus.com>
+ * win/tkWinMenu.c: Merged from latest tcl8.1 source.
- * win/tkWinDialog.c: Enlarged the file dialog buffer to include more
- files that the magic (14 files) limit.
+1998-11-06 Ian Roxborough <irox@cygnus.com>
-Wed Aug 12 18:24:45 1998 Ian Lance Taylor <ian@cygnus.com>
+ * win/tkWinDialog.c (GetFileName): Add support for --multiple to
+ tk_getOpenFile.
- * win/Makefile.in (TK_CFLAGS): Remove $(include32).
+1998-11-06 Syd Polk <spolk@cygnus.com>
-Fri Jul 31 14:37:29 1998 Ian Roxborough <irox@cygnus.com>
+ * win/tkWinMenu.c (GetEntryText): Fixed menubars and system
+ menu character set problems.
+ * win/tkWinWm.c: Fixed title bar text character set problems.
- * win/Makefile.in: add tkTextCharType symbol to tkcyg.def require by SN.
+1998-10-28 Syd Polk <spolk@cygnus.com>
-Mon Jul 22 15:44:19 1998 Ian Roxborough <irox@cygnus.com>
+ * win/Makefile.in: Remove prolog.ps from install
- * win/Makefile.in: add some symbols to tkcyg.def require by SN.
+1998-10-26 Syd Polk <spolk@cygnus.com>
-Mon Jul 13 14:12:39 1998 Jeff Holcomb <jeffh@cygnus.com>
+ * win/Makefile.in: Change tcl directory.
+ * win/configure.in: XINCLUDES needs be generated correctly.
+ * win/configure: Regenerated.
- * win/tkWinX.c: Removed temporary define for MNC_CLOSE.
+1998-10-23 Ben Elliston <bje@cygnus.com>
+
+ * generic/tkFont.c (Tk_UnderlineChars): Count multibyte characters
+ correctly when underlining. Contributed by Scott Stanton
+ <stanton@scriptics.com>.
+
+1998-10-20 Syd Polk <spolk@cygnus.com>
+
+ * unix/configure.in: Work with tcl8.1 directory name
+ * unix/configure: Regenerated
+
+1998-10-04 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Somehow this ended up on the main branch.
+
+1998-10-14 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in configure.in: More work for tk 8.1 build.
+ * win/configure: Regenerated
+ * win/tkWinDialog.c: Added dummy -multiple option. irox will re-implement
+ this soon.
+
+1998-09-29 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Generate the correct version number
+ * win/configure: Regenerated.
+ * win/Makefile.in: Now compiles for Visual C++.
+ * win/tkWinFont.c win/TkWinInt.h win/TkWinWm.c: Removed changing
+ font map when system changes. 8.1 is eventually supposed to support
+ this and the font package changed dramatically. The changes were
+ not easy to bring forward, so we will have to do something if
+ Tk 8.1 does not support this.
+
+1998-09-29 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Merged from devo
+ * win/configure: Regenerated.
+
+1998-09-28 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Fixes for OBJEXT; removed hard-coded 80
+ references; added new tk files for 8.1.
+
+Wed Aug 19 17:48:00 PDT 1998 Syd Polk <spolk@cygnus.com>
+
+ * Continued 8.1 integration
Mon Jul 6 18:13:02 1998 Martin M. Hunt <hunt@cygnus.com>
@@ -873,7 +3692,7 @@ Sun Aug 20 00:15:51 1995 Jason Molenda (crash@phydeaux.cygnus.com)
conflict with the one in the new tcl/tclBasic.c.
Mon Jun 12 17:09:28 1995 Stu Grossman (grossman@cygnus.com)
-
+
* configure: Ignore --cache-file option instead of bombing out.
Mon Dec 12 12:17:16 1994 Stu Grossman (grossman@cygnus.com)
diff --git a/tk/README b/tk/README
index d75186be68b..15233d6471c 100644
--- a/tk/README
+++ b/tk/README
@@ -1,393 +1,43 @@
-The Tk Toolkit
+README: Tk
+ This is the Tk 8.3.2 source distribution.
+ You can get any release of Tcl from:
+ http://dev.scriptics.com/registration/<version>.html
+ Tcl/Tk is also available through NetCVS:
+ http://dev.scriptics.com/software/tcltk/netcvs.html
RCS: @(#) $Id$
1. Introduction
---------------
-This directory and its descendants contain the sources and documentation
-for Tk, an X11 toolkit implemented with the Tcl scripting language. The
-information here corresponds to Tk 8.0.3, which is the third patch update
-for Tk 8.0. This release is designed to work with Tcl 8.0.3 and may not
-work with any other version of Tcl.
+This directory contains the sources and documentation for Tk, an X11
+toolkit implemented with the Tcl scripting language.
-Tk 8.0 is a major release with significant new features such as native
-look and feel on Macintoshes and PCs, a new font mechanism, application
-embedding, and proper support for Safe-Tcl. See below for details.
-There should be no backward incompatibilities in Tk 8.0 that affect
-scripts. This patch release fixes various bugs in Tk 8.0; there are no
-feature changes relative to Tk 8.0.
+For details on features, incompatibilities, and potential problems with
+this release, see the Tcl/Tk 8.3 Web page at
-Note: with Tk 8.0 the Tk version number skipped from 4.2 to 8.0. The
-jump was made in order to synchronize the Tcl and Tk version numbers.
+ http://dev.scriptics.com/software/tcltk/8.3.html
-2. Documentation
-----------------
+or refer to the "changes" file in this directory, which contains a
+historical record of all changes to Tk.
-The best way to get started with Tk is to read one of the introductory
-books on Tcl and Tk:
+Tk is maintained, enhanced, and distributed freely as a
+service to the Tcl community by Scriptics Corporation.
+The official home for Tcl/Tk is on the Scriptics Web site:
- Practical Programming in Tcl and Tk, 2nd Edition, by Brent Welch,
- Prentice-Hall, 1997, ISBN 0-13-616830-2
+ http://dev.scriptics.com
- Tcl and the Tk Toolkit, by John Ousterhout,
- Addison-Wesley, 1994, ISBN 0-201-63337-X
+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.
- Exploring Expect, by Don Libes,
- O'Reilly and Associates, 1995, ISBN 1-56592-090-2
+2. See Tcl README
+-----------------
-Other books are listed at
-http://www.scriptics.com/resource/doc/books/
-http://www.tclconsortium.org/resources/books.html
+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.
-The "doc" subdirectory in this release contains a complete set of
-reference manual entries for Tk. Files with extension ".1" are for
-programs such as wish; files with extension ".3" are for C library
-procedures; and files with extension ".n" describe Tcl commands. To
-print any of the manual entries, cd to the "doc" directory and invoke
-your favorite variant of troff using the normal -man macros, for example
- ditroff -man wish.1
-
-to print wish.1. If Tk has been installed correctly and your "man"
-program supports it, you should be able to access the Tcl manual entries
-using the normal "man" mechanisms, such as
-
- man wish
-
-If you are porting Tk 3.6 scripts to Tk 4.0 or later releases, you may
-find the Postscript file doc/tk4.0.ps useful. It is a porting guide
-that summarizes the new features and discusses how to deal with the
-changes in Tk 4.0 that are not backwards compatible.
-
-There is also an official home for Tcl and Tk on the Web:
- http://www.scriptics.com/
-These Web pages include release updates, reports on bug fixes and porting
-issues, HTML versions of the manual pages, and pointers to many other
-Tcl/Tk Web pages at other sites. Check them out!
-
-3. Compiling and installing Tk
-------------------------------
-
-This release contains everything you should need to compile and run
-Tk under UNIX, Macintoshes, and PCs (either Windows NT, Windows 95,
-or Windows 98.)
-
-Before trying to compile Tk you should do the following things:
-
- (a) Check for a binary release. Pre-compiled binary releases are
- available now for PCs and Macintoshes, and several flavors of
- UNIX. Binary releases are much easier to install than source
- releases. To find out whether a binary release is available for
- your platform, check the home page for Tcl/Tk
- (http://www.scriptics.com/) and also check in the FTP
- directory from which you retrieved the base distribution.
-
- (b) Make sure you have the most recent patch release. Look in the
- FTP directory from which you retrieved this distribution to see
- if it has been updated with patches. Patch releases fix bugs
- without changing any features, so you should normally use the
- latest patch release for the version of Tk that you want.
- Patch releases are available in two forms. A file like
- tk8.0p1.tar.Z is a complete release for patch level 1 of Tk
- version 8.0. If there is a file with a higher patch level than
- this release, just fetch the file with the highest patch level
- and use it.
-
- Patches are also available in the form of patch files that just
- contain the changes from one patch level to another. These
- files have names like tk8.0p1.patch, tk8.0p2.patch, etc. They
- may also have .gz or .Z extensions to indicate compression. To
- use one of these files, you apply it to an existing release with
- the "patch" program. Patches must be applied in order:
- tk8.0p1.patch must be applied to an unpatched Tk 8.0 release
- to produce a Tk 8.0p1 release; tk8.0p2.patch can then be
- applied to Tk 8.0p1 to produce Tk 8.0p2, and so on. To apply an
- uncompressed patch file such as tk8.0p1.patch, invoke a shell
- command like the following from the directory containing this
- file (you may need to replace "patch -p" with "patch -p0"
- depending on your version of the patch program):
- patch -p < tk8.0p1.patch
- If the patch file has a .gz extension, it was compressed with
- gzip. To apply it, invoke a command like the following:
- gunzip -c tk8.0p1.patch.gz | patch -p
- If the patch file has a .Z extension, it was compressed with
- compress. To apply it, invoke a command like the following:
- zcat tk8.0p1.patch.Z | patch -p
- If you're applying a patch to a release that has already been
- compiled, then before applying the patch you should cd to the
- "unix" subdirectory and type "make distclean" to restore the
- directory to a pristine state.
-
-Once you've done this, change to the "unix" subdirectory if you're
-compiling under UNIX, "win" if you're compiling under Windows, or
-"mac" if you're compiling on a Macintosh. Then follow the instructions
-in the README file in that directory for compiling Tk, installing it,
-and running the test suite.
-
-4. Getting started
-------------------
-
-The best way to get started with Tk is by reading one of the introductory
-books.
-
-The subdirectory library/demos contains a number of pre-canned scripts
-that demonstrate various features of Tk. See the README file in the
-directory for a description of what's available. The file
-library/demos/widget is a script that you can use to invoke many individual
-demonstrations of Tk's facilities, see the code that produced the demos,
-and modify the code to try out alternatives.
-
-5. Summary of changes in Tk 8.0
--------------------------------
-
-Here is a list of the most important new features in Tk 8.0. The
-release also includes several smaller feature changes and bug fixes.
-See the "changes" file for a complete list of all changes.
-
- 1. Native look and feel. The widgets have been rewritten to provide
- (nearly?) native look and feel on the Macintosh and PC. Many
- widgets, including scrollbars, menus, and the button family, are
- implemented with native platform widgets. Others, such as entries
- and texts, have been modified to emulate native look and feel.
- These changes are backwards compatible except that (a) some
- configuration options are now ignored on some platforms and (b) you
- must use the new menu mechanism described below to native look and
- feel for menus.
-
- 2. There is a new interface for creating menus, where a menubar is
- implemented as a menu widget instead of a frame containing menubuttons.
- The -menu option for a toplevel is used to specify the name of the
- menubar; the menu will be displayed *outside* the toplevel using
- different mechanisms on each platform (e.g. on the Macintosh the menu
- will appear at the top of the screen). See the menu demos in the
- widget demo for examples. The old style of menu still works, but
- does not provide native look and feel. Menus have several new
- features:
- - New "-columnbreak" and "-hideMargin" options make it possible
- to create multi-column menus.
- - It is now possible to manipulate the Apple and Help menus on
- the Macintosh, and the system menu on Windows. It is also
- possible to have a right justified Help menu on Unix.
- - Menus now issue the virtual event <<MenuSelect>> whenever the
- current item changes. Applications can use this to generate
- help messages.
- - There is a new "-direction" option for menubuttons, which
- controls where the menu pops up revenues to the button.
-
- 3. The font mechanism in Tk has been completely reworked:
- - Font names need not be nasty X LFDs: more intuitive names
- like {Times 12 Bold} can also be used. See the manual entry
- font.n for details.
- - Font requests always succeed now. If the requested font is
- not available, Tk finds the closest available font and uses
- that one.
- - Tk now supports named fonts whose precise attributes can be
- changed dynamically. If a named font is changed, any widget
- using that font updates itself to reflect the change.
- - There is a new command "font" for creating named fonts and
- querying various information about fonts.
- - There are now officially supported C APIs for measuring and
- displaying text. If you use these APIs now, your code will
- automatically handle international text when internationalization
- is added to Tk in a future release. See the manual entries
- MeasureChar.3, TextLayout.3, and FontId.3.
- - The old C procedures Tk_GetFontStruct, Tk_NameOfFontStruct,
- and Tk_FreeFontStruct have been replaced with more portable
- procedures Tk_GetFont, Tk_NameOfFont, and Tk_FreeFont.
-
- 4. Application embedding. It is now possible to embedded one Tcl/Tk
- application inside another, using the -container option on frame
- widgets and the -use option for toplevel widgets or on the command
- line for wish. Embedding should be fully functional under Unix,
- but the implementation is incomplete on the Macintosh and PC.
-
- 5. Tk now works correctly with Safe-Tcl: it can be loaded into
- safe interpreters using safe::loadTk.
-
- 6. Text widgets now allow images to be embedded directly in the
- text without using embedded windows. This is more efficient and
- provides smoother scrolling.
-
- 7. Buttons have a new -default option for drawing default rings in
- a platform-specific manner.
-
- 8. There is a new "gray75" bitmap, and the "gray25" bitmap is now
- really 25% on (due to an ancient mistake, it had been only 12% on).
- The Macintosh now supports native bitmaps, including new builtin
- bitmaps "stop", "caution", and "note", plus the ability to use
- bitmaps in the application's resource fork.
-
- 9. The "destroy" command now ignores windows that don't exist
- instead of generating an error.
-
-Tk 8.0 introduces the following incompatibilities that may affect Tcl/Tk
-scripts that worked under Tk 4.2 and earlier releases:
-
- 1. Font specifications such as "Times 12" now interpret the size
- as points, whereas it used to be pixels (this was actually a bug,
- since the behavior was documented as points). To get pixels now,
- use a negative size such as "Times -12".
-
- 2. The -transient option for menus is no longer supported. You can
- achieve the same effect with the -type field.
-
- 3. In the canvas "coords" command, polygons now return only the
- points that were explicitly specified when the polygon was created
- (they used to return an extra point if the polygon wasn't originally
- closed). Internally, polygons are still closed automatically for
- purposes of display and hit detection; the extra point just isn't
- returned by the "coords" command.
-
- 4. The photo image mechanism now uses Tcl_Channels instead of FILEs,
- in order to make it portable. FILEs are no longer used anywhere
- in Tk. The procedure Tk_FindPhoto now requires an extra "interp"
- argument in order to fix a bug where images in different interpreters
- with the same name could get confused.
-
- 5. The procedures Tk_GetFontStruct, Tk_NameOfFontStruct,
- and Tk_FreeFontStruct have been removed.
-
-Note: the new compiler in Tcl 8.0 may also affect Tcl/Tk scripts; check
-the Tcl documentation for information on incompatibilities introduced by
-Tcl 8.0.
-
-6. Tcl/Tk newsgroup
--------------------
-
-There is a network news group "comp.lang.tcl" intended for the exchange
-of information about Tcl, Tk, and related applications. Feel free to use
-this newsgroup both for general information questions and for bug reports.
-We read the newsgroup and will attempt to fix bugs and problems reported
-to it.
-
-When using comp.lang.tcl, please be sure that your e-mail return address
-is correctly set in your postings. This allows people to respond directly
-to you, rather than the entire newsgroup, for answers that are not of
-general interest. A bad e-mail return address may prevent you from
-getting answers to your questions. You may have to reconfigure your news
-reading software to ensure that it is supplying valid e-mail addresses.
-
-7. Mailing lists
-----------------
-
-A couple of Mailing List have been set up to discuss Macintosh or
-Windows related Tcl issues. In order to use these Mailing Lists you
-must have access to the internet. To subscribe send a message to:
-
- wintcl-request@tclconsorium.org
- or
- mactcl-request@tclconsorium.org
-
-In the body of the message (the subject will be ignored) put:
-
- subscribe mactcl Joe Blow
-
-Replacing Joe Blow with your real name, of course. (Use wintcl
-instead of mactcl if your interested in the Windows list.) If you
-would just like to receive more information about the list without
-subscribing but the line:
-
- information mactcl
-
-in the body instead (or wintcl).
-
-8. Tcl/Tk contributed archive
---------------------------
-
-Many people have created exciting packages and applications based on Tcl
-and/or Tk and made them freely available to the Tcl community. An archive
-of these contributions is kept on the machine ftp.neosoft.com. You
-can access the archive using anonymous FTP; the Tcl contributed archive is
-in the directory "/pub/tcl". The archive also contains several FAQ
-("frequently asked questions") documents that provide solutions to problems
-that are commonly encountered by TCL newcomers.
-
-9. Tcl Resource Center
-----------------------
-Visit http://www.scritics.com/resource/ to see an annotated index of
-many Tcl resources available on the World Wide Web. This includes
-papers, books, and FAQs, as well as extensions, applications, binary
-releases, and patches. You can contribute patches by sending them
-to <patches@scriptics.com>. You can also recommend more URLs for the
-resource center using the forms labeled "Add a Resource".
-
-10. Support and bug fixes
-------------------------
-
-We're very interested in receiving bug reports and suggestions for
-improvements. We prefer that you send this information to the
-comp.lang.tcl newsgroup rather than to any of us at Scriptics. We'll see
-anything on comp.lang.tcl, and in addition someone else who reads
-comp.lang.tcl may be able to offer a solution. The normal turn-around
-time for bugs is 3-6 weeks. Enhancements may take longer and may not
-happen at all unless there is widespread support for them (we're
-trying to slow the rate at which Tk turns into a kitchen sink). It's
-very difficult to make incompatible changes to Tcl at this point, due
-to the size of the installed base.
-
-When reporting bugs, please provide a short wish script that we can
-use to reproduce the bug. Make sure that the script runs with a
-bare-bones wish and doesn't depend on any extensions or other
-programs, particularly those that exist only at your site. Also,
-please include three additional pieces of information with the
-script:
- (a) how do we use the script to make the problem happen (e.g.
- what things do we click on, in what order)?
- (b) what happens when you do these things (presumably this is
- undesirable)?
- (c) what did you expect to happen instead?
-
-The Tcl/Tk community is too large for us to provide much individual
-support for users. If you need help we suggest that you post questions
-to comp.lang.tcl. We read the newsgroup and will attempt to answer
-esoteric questions for which no-one else is likely to know the answer.
-In addition, Tcl/Tk support and training are available commercially from
-Scriptics (info@scriptics.com), NeoSoft (info@neosoft.com),
-Computerized Processes Unlimited (gwl@cpu.com),
-and Data Kinetics (education@dkl.com).
-
-11. Release organization
-------------------------
-
-The version numbers described below are available to Tcl scripts
-as the tk_version and tk_patchLevel Tcl variables.
-
-Each Tk release is identified by two numbers separated by a dot, e.g.
-3.2 or 3.3. If a new release contains changes that are likely to break
-existing C code or Tcl scripts then the major release number increments
-and the minor number resets to zero: 3.0, 4.0, etc. If a new release
-contains only bug fixes and compatible changes, then the minor number
-increments without changing the major number, e.g. 3.1, 3.2, etc. If
-you have C code or Tcl scripts that work with release X.Y, then they
-should also work with any release X.Z as long as Z > Y.
-
-Alpha and beta releases have an additional suffix of the form a2 or b1.
-For example, Tk 3.3b1 is the first beta release of Tk version 3.3,
-Tk 3.3b2 is the second beta release, and so on. A beta release is an
-initial version of a new release, used to fix bugs and bad features
-before declaring the release stable. An alpha release is like a beta
-release, except it's likely to need even more work before it's "ready
-for prime time". New releases are normally preceded by one or more
-alpha and beta releases. We hope that lots of people will try out
-the alpha and beta releases and report problems. We'll make new alpha/
-beta releases to fix the problems, until eventually there is a beta
-release that appears to be stable. Once this occurs we'll make the
-final release.
-
-We can't promise to maintain compatibility among alpha and beta releases.
-For example, release 4.1b2 may not be backward compatible with 4.1b1, even
-though the final 4.1 release will be backward compatible with 4.0. This
-allows us to change new features as we find problems during beta testing.
-We'll try to minimize incompatibilities between beta releases, but if a
-major problem turns up then we'll fix it even if it introduces an
-incompatibility. Once the official release is made then there won't
-be any more incompatibilities until the next release with a new major
-version number.
-
-Patch releases used to have a suffix such as p1 or p2. Now we use
-a 3-part version number: major.minor.patchlevel. (e.g., 8.0.3)
-These releases contain bug fixes only. A patch release (e.g Tk 4.1p2)
-should be completely compatible with the base release from which it is
-derived (e.g. Tk 4.1), and you should normally use the highest available
-patch release.
diff --git a/tk/ToDo b/tk/ToDo
new file mode 100644
index 00000000000..683dc804260
--- /dev/null
+++ b/tk/ToDo
@@ -0,0 +1,90 @@
+This file contains a list of bugs to fix and minor feature changes
+needed in the Tk toolkit. The list is ordered by the time when the
+idea for the change first arose; no priority should be inferred from
+the order.
+
+sccsid = SCCS: @(#) ToDo 1.8 96/02/16 10:55:14
+
+106. Add feature to buttons for automatic defaulting, where button
+allocates extra space for default ring.
+
+136. Implement mechanism for using existing window as main window for
+application, support with command-line argument in wish.
+
+139. Change canvas Postscript generation to be smarter about font names
+that have been abbreviated: use X to look up the full name.
+
+147. Add "window" entry to menus.
+
+148. Add an "initProc" and a "freeProc" to TK_CONFIG_CUSTOM config types.
+
+150. In SYNONYM options, specify a command-line switch for the other
+option, not a database name.
+
+153. Some fonts (e.g. Times) have underline characters that extend
+*below* the official descent of the font. Right now the underline
+is invisible for these fonts in text widgets. Find a way to make
+this work in text?
+
+150. Change the bindings for menubuttons to watch mouse motion events
+and map them to menu or menubutton windows "by hand", so as to eliminate
+the need for a menu to be a descendant of the menubutton.
+
+151. Create an I/O event handler so that Tk can continue after a server
+connection is lost.
+
+153. Allow Tk applications to be embedded inside other Tk applications:
+ - Allow the window for a widget to be specified explicitly, rather
+ than being created automatically by Tk. This would allow the
+ main window for one application to use an internal window that
+ already exists in another application.
+ - Modify wish's main.c to allow a window id for the main window to
+ be specified as a command-line argument.
+ - Build a special widget for embedding other applications, which will
+ implement the window-manager side of the ICCCM protocols, e.g.,
+ feeding requested size information up from the embedded application
+ into the enclosing widget hierarchy.
+
+154. Improvements to canvases:
+ - Allow items to be rotated?
+ - Allow polygons to be outlined.
+ - Make "raise" of window items work correctly.
+ - In the "find" widget option, make it possible to restrict search
+ to a particular tag.
+ - Allow items to become visible/invisible.
+
+156. Add a "wm anchor" option to make it easier to center windows.
+
+157. Various improvements to option database:
+ - Allow patterns to be read from database or deleted from database.
+ - Allow database to be cleared without automatically reloading from
+ .Xdefaults files.
+ - Allow additional info to be read from various window properties.
+ - Support new wildcards from X11R5.
+ - Allow mechanism to extend to cover cases where there isn't even
+ a window, or even an application by the name used in the option
+ get command.
+ - Allow options in database to override those specified on Tcl
+ command lines?
+ - Revert to X conflict-resolution scheme?
+
+158. Make it possible for wish to run without a display.
+
+159. Change option tables to be arrays of pointers, rather than arrays of
+entries? Makes it easier to keep separate named structures for particular
+options, e.g. so that you can tell when an option has changed.
+
+160. Change text scrolling so that the top of the window can fall in
+the middle of a text line.
+
+161. Allow text tabs to be specified in units of characters, rather
+than just inches.
+
+162. Fix tk_strictMotif to make it easier to turn on and off (e.g.
+conditionalize the binding scripts, rather than the creation of
+the bindings).
+
+163. Change text bindings so that Enter and Leave events occur when
+the mouse moves between disjoint ranges with the same tag.
+
+164. Provide block insertion cursor in text widgets.
diff --git a/tk/changes b/tk/changes
index 8ef41cf4dbf..21e10a07dcf 100644
--- a/tk/changes
+++ b/tk/changes
@@ -4010,19 +4010,19 @@ virtual events now go to the correct (focus) window. (RJ)
9/19/97 (bug fix) Made Macintosh tearoff menus non-resizable. (RJ)
+10/9/97 (bug fix) Default font for new canvas text items was hardcoded to
+"Helvetica 12" instead of using DEF_CANVTEXT_FONT defined in
+tk{platform}Default.h like all the other widget settings. (CCS)
+
10/9/97 (bug fix) Image code could cause crashes during "exit" under
some conditions (such as an image named "place"). (JO)
10/9/97 (bug fix) Fixed bug that sometimes prevented listboxes from
scrolling far enough horizontally to see the rightmost character. (JO)
-10/9/97 (bug fix) Default font for new canvas text items was hardcoded to
-"Helvetica 12" instead of using DEF_CANVTEXT_FONT defined in
-tk{platform}Default.h like all the other widget settings. (CCS)
-
-10/10/97 (bug fix) In canvas text items, if the text ended with a \n, it
-was not counted in the bbox height, as it did in tk4.2. This caused
-"hello\n" to be the same height as "hello" and you couldn't see the
+10/10/97 (bug fix) In canvas text items, if the text ended with a \n, it
+was not counted in the bbox height, as it did in tk4.2. This caused
+"hello\n" to be the same height as "hello" and you couldn't see the
cursor positioned on the next line. (CCS)
10/10/97 (bug fix) The grid geometry manager didn't always properly
@@ -4278,7 +4278,651 @@ format. If you have extensions built with the o32 abi's you will need
to update them to n32 for them to work with Tcl. (RJ)
*** POTENTIAL INCOMPATIBILITY ***
-11/10/98 (feature change) The Macintosh menus will use the Appearance Theme
-backgrounds, separators and menu shape, if Appearance version 1.0.1 or
-greater is installed. The version of Appearance that shipped with MacOS 8.0
-so it will not work with a straight 8.0, but it will with MacOS 8.1 or later. (JI)
+11/10/98 (feature change) The Macintosh menus will use the Appearance
+Theme backgrounds, separators and menu shape, if Appearance version
+1.0.1 or greater is installed. The version of Appearance that shipped
+with MacOS 8.0 so it will not work with a straight 8.0, but it will
+with MacOS 8.1 or later. (JI)
+
+----------------- Released 8.0.4, 11/20/98 -----------------------
+
+11/24/98 (bug fix) On some X servers, XQueryLoadFont will always
+return a font, even if the name is meaningless. This prevents Tk from
+parsing the font name, so now we perform a quick sanity check on the
+name before letting X have it. (stanton)
+
+12/30/98 (bug fix) Fixed bug in "grid forget" that failed to cancel
+pending idle handlers, resulting in a crash in a few odd cases. (stanton)
+
+1/28/99 (configure change) Now support -pipe option on gcc. (RJ)
+
+2/4/99 (bug fix) Changed so color tables in photo images are freed
+immediately instead of being delayed. This ensures that color tables
+are properly disposed at process exit. (stanton)
+
+2/4/99 (bug fix) Changed postscript template to include a European
+character with an umlaut when determining font height. (stanton)
+
+2/4/99 (bug fix) If an image bitmap mask changed but ended up with the
+same XID, the GC failed to be updated and so the new mask was
+not used. (stanton)
+
+2/4/99 (bug fix) Changed so focus window is always set if -force is
+specified. This fixes the problem on Windows where Tk does not
+activate the window if it already has focus. (stanton)
+
+2/4/99 (bug fix) Fixed so errors in console eval are reported
+properly. Eliminated duplicate result messages. (stanton)
+
+2/4/99 (bug fix) Under Windows, changed so toplevels that aren't
+resizable don't have resize handles and the zoom box is disabled. (stanton)
+
+2/4/99 (bug fix) Changed to cancel the mouse timer when a user
+initiated move/resize loop begins on Windows. (stanton)
+
+2/4/99 (configure change) TK_LD_SEARCH_FLAGS was set incorrectly if
+SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C
+compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also
+with gcc on many more systems.
+
+2/4/99 (bug fix) Changed some EXTERN declarations to extern since they
+are not defining exported interfaces. This avoids generating useless
+declspec() attributes and makes the Windows makefile simpler. (stanton)
+
+2/4/99 (bug fix) Changed so keyboard shortcuts will only be found in
+the current toplevel. Previously, they might be found in menus
+attached to other toplevels that might not even be mapped. (stanton)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/4/99 (bug fix) Changed to treat zero width lines in the canvas like
+they have width 1 for purposes of selection. (stanton)
+
+2/4/99 (bug fix) Added a workaround for a bug in GetTextExtentExPoint
+on Win NT 4.0/Japanese that cause a crash in some cases. (stanton)
+
+2/4/99 (bug fix) Fixed uninitialized memory access bug in Unix send
+code. (stanton)
+
+----------------------------------------------------------
+Changes for Tk 8.0 go above this line.
+Changes for Tk 8.1 go below this line.
+----------------------------------------------------------
+
+1/16/98 (new feature) Tk now supports international characters sets:
+ - Font display mechanism overhauled to display Unicode strings
+ containing full set of international characters. You do not need
+ Unicode fonts on your system in order to use tk or see international
+ characters. For those familiar with the Japanese or Chinese patches,
+ there is no "-kanjifont" option. Characters from any available fonts
+ will automatically be used if the widget's originally selected font is
+ not capable of displaying a given character.
+ - Textual widgets are international aware. For instance, cursor
+ positioning commands would now move the cursor forwards/back by 1
+ international character, not by 1 byte.
+ - Input Method Editors (IMEs) work on Mac and Windows. Unix is still in
+ progress.
+
+7/7/97 (new feature) The send command now works for Microsoft
+Windows. It is implemented using Dynamic Data Exchange, and a new
+command, dde, allows Tk to send more generic DDE commands to other
+applications. (SRP)
+
+11/3/97 (new feature) Major overhaul of code that manages configuration
+options to use Tcl_Obj structures instead of strings:
+ - There is a new set of procedures including Tk_CreateOptionTable,
+ Tk_InitOptions, and Tk_SetOptions, which replace Tk_ConfigureWidget
+ and related procedures. The old procedures are still available.
+ The new procedures use a new format for configuration tables.
+ See SetOptions.3 for more information.
+ - There are new procedures Tk_AllocColorFromObj, Tk_GetColorFromObj,
+ and Tk_FreeColorFromObj to manage colors using objects to hold the
+ name of the color and cache the corresponding XColor pointer.
+ There are similar procedures Tk_Alloc3DBorderFromObj,
+ Tk_AllocBitmapFromObj, Tk_AllocCursorFromObj, Tk_AllocFontFromObj,
+ and so on to manage borders, bitmaps, cursors, and fonts.
+ - The old-style procedures such as Tk_GetColor and Tk_GetBitmap no
+ longer take Tk_Uids for arguments; they just take strings.
+ - Menus, labels, buttons, checkbuttons, and radiobuttons have been
+ converted to use the new object-based configuration library.
+ (SRP & JO)
+
+11/7/97 (improvement) Changed code referring to "interp->result" to call
+accessor functions like Tcl_SetResult().
+
+12/23/97 (fix) Fixed transparency and web optimized the palette of
+the images/ Tcl powered logos. (DL)
+
+12/16/97 (bug fix) Canvas and text "bind" subcommands generated an
+error with no message if called to fetch a binding that didn't exist.
+They now silently return without an error like the "bind" command. (SS)
+
+1/13/98 (bug fix) Keysyms for international characters were not being
+reported properly under Windows. (SS)
+
+----------------- Released 8.1a1, 1/22/98 -----------------------
+
+2/4/98 (bug fix) Calling XFreeFontNames() twice if couldn't allocate
+font. (CCS)
+
+2/10/98 (bug fix) Inlined prolog.ps in tkCanvPs.c to make it accessible
+from safe interpreters: canvas postscript now works in safe interps
+(like in tk8.0plugin). (DL)
+
+2/11/98 (bug fix) Windows "send" to a remote interp wasn't propagating
+$errorInfo correctly from the remote interp to the local invoking interp.
+(CCS)
+
+2/11/98 (bug fix) Windows "send" should have accepted "--" to mean "no more
+arguments". (CCS)
+
+2/11/98 (bug fix) Windows "send" was concatenating its arguments
+incorrectly (not consistent with "eval", "uplevel", or Unix "send"). (CCS)
+
+2/18/98 (bug fix) Macintosh radiobuttons and checkbuttons now color
+their backgrounds correctly under Appearance. The controls gadgets themselves
+however, remain the Theme colors. (JI)
+
+2/18/98 (improvement) The corner pixels that peek through around the
+rounded corners of the Mac button widget are now controlled by the
+-highlightbackground, rather than the -background option. (JI)
+
+2/18/98 (improvement) Implemented the intra-application Send on the
+Mac (RJ)
+
+2/18/98 (bug fix) Under X, a problem mapping from a fontStructPtr to an
+XLFD (no XA_FONT attribute) would lead to dereferencing NULL. (CCS)
+
+----------------- Released 8.1a2, Feb 20 1998 -----------------------
+
+10/21/98 (bug fix) Tk_UnderlineChars did not handle UTF strings properly
+so underline indices were in bytes instead of characters. (stanton)
+
+11/19/98 (bug fix) Fixed menus and titles so they properly display
+Unicode characters under Windows. [Bug: 819] (stanton)
+
+11/24/98 (bug fix) Fixed a bunch of memory leaks in the Windows menu
+code. [Bug: 620] (stanton)
+
+11/25/98 (bug fix) Various small bug fixes: (stanton)
+ - hidemargin option was not honored properly in menus [Bug: 859]
+ - disabled menu entries were getting reenabled whenever the
+ mouse passed over the entry [Bug: 860]
+ - fixed deletion order bug where a crash would result if a
+ binding deleted "."
+
+11/30/98 (bug fix) The error result was getting lost when restoring
+configuration options in buttons. [Bug: 619] (stanton)
+
+12/8/98 (bug fix) The Windows clipboard was not correctly traslating
+multibyte characters. [Bug: 935] (stanton)
+
+----------------- Released 8.1b1, Dec 11 1998 -----------------------
+
+1/29/99 (bug fix) Fixed bug in "grid forget" that failed to cancel
+pending idle handlers, resulting in a crash in a few odd
+cases. (stanton)
+
+2/4/99 (bug fix): Fixed uninitialized memory access in
+Tk_SetAppName. [Bug: 919] (stanton)
+
+2/4/99 (bug fix): Added a workaround for a bug in GetTextExtentExPoint
+on Win NT 4.0/Japanese. [Bug: 1006] (stanton)
+
+2/4/99 (bug fix): Changed so keyboard shortcuts for menus will only be
+found in the current toplevel. Previously, they might be found in
+menus attached to other toplevels that might not even be mapped.
+[Bug: 924] (stanton)
+
+2/4/99 (bug fix): Changed to treat zero width lines in the canvas like
+they have width 1 for purposes of selection. [Bug: 925] (stanton)
+
+2/4/99 (bug fix): TK_LD_SEARCH_FLAGS was set incorrectly if
+SHLIB_LD_LIBS='${LIBS}', and shared linking is performed through the C
+compiler. Systems affected are Linux, MP-RAS and NEXTSTEP, but also
+with gcc on many more systems. [Bug: 908] (stanton)
+
+2/4/99 (feature enhancement): Changed so windows that aren't resizable
+don't have resize handles and the zoom box is disabled on
+Windows. (stanton)
+
+2/4/99 (bug fix): Fixed so errors in console eval are reported
+properly. Eliminated duplicate result messages. [Bug: 973] (stanton)
+
+2/4/99 (bug fix): Changed so focus window is always set if -force is
+specified. This fixes the problem on Windows where Tk does not
+activate the window if it already has focus. (stanton)
+
+2/4/99 (bug fix): If an image mask changed but ended up with the same
+XID, the GC failed to be updated and so the new mask was not
+used. [Bug: 970] (stanton)
+
+2/12/99 (new feature): Tk is now thread safe. You enable this by
+configuring with --enable-threads. Tcl must also be compiled with
+--enable-threads. See Tcl for more information about the threading
+interfaces. (lfb)
+
+2/25/99 (bug fix) Under Windows, wish can now inherit pipe handles on
+stdio so it is possible to use the wish executable in a command
+pipeline to capture the output of puts or read from the pipe with
+gets. (redman)
+
+3/1/99 (bug fix) Under Windows, Tk was not properly handling focus and
+activation changes in some cases. (redman)
+
+3/10/99 (new feature) Tk now uses the new stub library feature in Tcl.
+The Tk library now contains no direct references to any symbols in
+Tcl. In addition, there is a new Tk_MainEx() function that takes an
+interpreter as an argument. See the Tcl documentation for more
+information about the stubs mechanism. (redman)
+
+3/14/99 (feature change) Test suite now uses "test" namespace to
+define the test procedure and other auxiliary procedures as well as
+global variables.
+ - Global array testConfige is now called ::test::testConfig.
+ - Global variable VERBOSE is now called ::test::verbose, and
+ ::test::verbose no longer works with numerical values. We've
+ switched to a bitwise character string. You can set
+ ::test::verbose by using the -verbose option on the Tk command
+ line.
+ - Global variable TESTS is now called ::test::matchingTests, and
+ can be set on the Tk command line via the -match option.
+ - There is now a ::test::skipTests variable (works similarly to
+ ::test::matchTests) that can be set on the Tk command line via
+ the -match option.
+ - The test suite can now be run in any working directory. When
+ you run "make test", the working directory is nolonger switched
+ to ../tests.
+(hirschl)
+*** POTENTIAL INCOMPATIBILITY ***
+
+----------------- Released 8.1b2, March 16, 1999 ---------------------
+
+3/23/99 (feature change) Test suite now uses "tcltest" namespace to
+define the test procedure and other auxiliary procedures as well as
+global variables. The previously chosen "test" namespace was thought
+to be too generic and likely to create conflits.
+(hirschl)
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/26/99 [bug fix] Fixed bug reported by Bryan Oakley in the
+menubutton bindings. There was a false assumption that there was
+always a menu attached to the button. [Bug 1116] (surles)
+
+3/26/99 (feature change) Removed --enable-tcl-stub from the configure
+script. Linking Tk to Tcl stubs is causing too many problems when
+linking executables like wish. Until the Tk is a fully loadable
+extension, linking against the Tcl stubs is not supported in Tk.
+(redman)
+
+3/26/99 (feature change) --nameble-shared is now the default and builds
+Tk as a shared library; specify --disable-shared to build a static Tk
+library and shell.
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/29/99 (api change) Standardized text layout and font interfaces
+so they are consistent with respect to byte versus character
+oriented indices. The layout functions all manipulate character
+oriented values while the lower level measurement functions all
+operate on byte oriented values. (stanton)
+
+4/1/99 (bug fix) Image handlers are finalized before the font subsystem
+to fix crashes during finalization of complex widgets. (stanton)
+
+4/1/99 (feature change) Removed the send command on Windows. Moved
+the DDE basis of that command out to its own extension. The send
+implementation on top of DDE was causing Tk to lock up in some cases.
+(redman)
+
+4/5/99 (bug fix) Fixed handling of Unicode in text searches. The
+-count option was returning byte counts instead of character counts.
+
+4/5/99 (feature change) Cut and paste to an entry widget returns the
+selection instead of the widget contents, which can be different if the
+-show option is used to hide the display. (stanton)
+
+--------------- Released 8.1b3, April 6, 1999 ----------------------
+
+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)
+
+4/22/99 (bug fix) Set the -translation and -encoding options to binary
+for image files. (redman)
+
+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)
+
+--------------- Released 8.1 final, April 29, 1999 ----------------------
+
+5/7/99 (bug fix) Fixed bug wheretk_popup fails when called too
+quickly. [Bug: 2009] (stanton)
+
+5/18/99 (bug fix) Fixed clipboard code so it handles Unicode data
+properly on Windows NT and 95. [Bug: 1791] (stanton)
+
+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)
+
+--------------- Released 8.1.1, May 25, 1999 ----------------------
+
+5/21/99 (bug fix) Fixed clipboard code to handle lack of CF_LOCALE
+information (from command.com). (stanton)
+
+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)
+
+6/3/99 (bug fix) Fixed selection code to handle Unicode data in
+COMPOUND_TEXT and STRING selections. [Bug: 1791] (stanton)
+
+6/16/99 (new feature) Changes to makefiles and configure scripts to
+support TEA specification. (wart)
+
+6/30/99 (bug fix) Removed deprecated functions, patch from Jan
+Nijtmans. [Bug 2080] (redman)
+
+6/30/99 (bug fix) Applied patch to allow Img extension to work with
+8.2, patch from Jan Nijtmans. [Bug 2068] (redman)
+
+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)
+
+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)
+
+--------------- Released 8.2b1, July 14, 1999 ----------------------
+
+7/16/99 (bug fix) Copy prolog.ps from the generic directory for
+install-libraries make target. (redman)
+
+7/22/99 (bug fix) Applied patch from Jeff Hobbs to fix
+library/menu.tcl. [Bug: 2425] (redman)
+
+7/22/99 (bug fix) Make install-sh have executable permissions before
+calling from the Makefile. [Bug: 2413] (redman)
+
+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)
+
+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)
+
+7/30/99 (bug fix) corrected the Windows build of threaded Tk from both
+sets of makefiles (nmake and gmake). (redman)
+
+7/30/99 (bug fix) Added XFillRectangle to stub table, patch from Jan
+Njitmans. [Bug: 2446] (hobbs)
+
+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)
+
+--------------- Released 8.2b2, August 5, 1999 ----------------------
+
+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)
+
+--------------- Released 8.2.0, August 17, 1999 ----------------------
+
+9/21/99 (bug fix) fixed 'wm deiconify' quirks on Windows. (hobbs)
+
+9/21/99 (bug fix) fix fg<>bg GC swap bug for canvas. [Bug: 2676] (hobbs)
+
+9/21/99 (config fix) fixed AIX config issues for Tk. (hobbs)
+
+9/24/99 (feature change) tk_dialog now uses {Times 12} by default. (hobbs)
+
+--- Released 8.2.1, October 04, 1999 --- See ChangeLog for details ---
+
+10/30/99 (bug fix) fixed XKeysymToKeycode to handle mapping of symbolic
+keysyms (Left, Home, ...) with event generate (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)
+
+10/30/99 (bug fix) changed tkScrollButtonUp to check for existence of
+tkPriv(relief) in order to avoid spurious release events (hobbs)
+
+--- Released 8.2.2, November 04, 1999 --- See ChangeLog for details ---
+
+11/19/99 (bug fix) fixed expression error that could cause
+'malformed bucket chain' error in tkEntry.c. (hobbs)
+
+11/19/99 (bug fix) fixed Tk_NameOfColor (hobbs)
+
+--- Released 8.2.3, December 16, 1999 --- See ChangeLog for details ---
+
+1999-09-01 (feature enhancement) rewrote runtime libraries to use new
+Tcl functions where appropriate
+
+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)
+
+1999-11-16 (feature enhancement) made listbox Tcl_Obj based, added
+-listvariable option and itemconfigure command to allow coloring
+individual items. (melski)
+
+1999-11-23 (feature enhancement) added TK_OPTION_DONT_SET_DEFAULT as an
+equivalent to TK_CONFIG_DONT_SET_DEFAULT (hobbs)
+
+1999-11-24 (feature enhancement) updated dialogs to use color icons on
+Unix, center properly over -parent. (hipp, hobbs)
+
+1999-12-01 (feature enhancement) added hooks into main() code to support
+"big" shells more easily. (redman)
+
+1999-12-02 (feature enhancement) converted Tk_DestroyCmd, Tk_LowerCmd and
+Tk_RaiseCmd to their ObjCmd equivalent.
+
+1999-12-12 (bug fix) fixed bug in TextSearchCmd for multibyte chars
+
+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)
+
+1999-12-16 (feature enhancement) added "bitstream cyberbit" to list of
+font fallbacks. (hobbs)
+
+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)
+
+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)
+
+1999-12-16 (bug fix) removed necessity of 'update idle' before 'wm
+deiconify' on Windows. (mao)
+
+1999-12-16 (feature enhancement) added support for Windows system cursors
+to TkGetCursorByName (use -cursor @filename)
+
+1999-12-21 (bug fix) fixed lack of refresh for thin frames (darley)
+
+1999-12-21 (bug fix) fixed panic in Tk_CoordsToWindow to print error
+to stderr instead (for Tix) (hobbs)
+
+1999-12-21 (bug fix) fixed segv with scale widget when using -cursor (hobbs)
+
+--- Released 8.3b1, December 22, 1999 --- See ChangeLog for details ---
+
+2000-01-05 (bug fix) Applied fixes for unprotected arg passing through eval
+and after in Tk runtime code [Bug: 3943] (hobbs)
+
+2000-01-05 (bug fix) Applied fix for i18n problems with Mac clipboard
+[Bug: 3544] (hobbs)
+
+2000-01-05 (feature change) removed the 8.3b1 introduced -state option
+for text tags, and documented -elide (-state hidden == -elide true) (hobbs)
+
+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)
+
+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)
+
+2000-01-12 (bug fix) Applied fix for cursor to not blink when entry or
+text widget was disabled [Bug: 1807] (hobbs)
+
+--- Released 8.3b2, January 13, 2000 --- See ChangeLog for details ---
+
+2000-01-20 (bug fix) fixed interpretation of consecutive ^ characters in
+grid command (melski)
+
+2000-01-20 (bug fix) fixed -select(bg|fg) class names in listbox (hobbs)
+
+2000-01-20 (bug fix) fixed handling of too few coords for line item type in
+canvas (hobbs)
+
+2000-01-20 (bug fix) fixed dialog's association with parent (melski)
+
+2000-01-26 (bug fix) fixed handling of binary data for -data option to
+image create (melski)
+
+2000-01-26 (feature enhancement) improved GIF decoding speed by ~60%
+(melski)
+
+2000-01-26 (feature enhancement) added tk_chooseDirectory implementation
+for Unix and Mac (nelson, melski)
+
+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)
+
+2000-02-01 (bug fix) fixed handling of negative dash values for canvas
+items (nijtmans)
+
+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)
+
+2000-02-03 (bug fix) fixed text dump to use char indices instead of byte
+indices (melski)
+
+2000-02-07 (bug fix) fixed handling of default extension in unix file
+dialogs (dejong)
+
+2000-02-08 (bug fix) corrected windows symbol font use to restrict itself
+to 8-bit chars (kenny)
+
+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)
+
+2000-02-08 (bug fix) fixed incorrect handling of CapsLock on Win9* and the
+use of dead keys on international keyboards (spjuth)
+
+2000-02-10 (bug fix) brought Mac back to building state, added support
+for Appearance Manager (ingham)
+
+2000-02-10 (feature enhancement) added support for buttons 4 && 5 as
+mousewheel style scrolling in listbox and text widget for Unix.
+
+--- Released 8.3.0, February 10, 2000 --- See ChangeLog for details ---
+
+2000-03-02 (bug fix) fixed crash in listbox when cursor was configure and
+then widget was destroyed (hobbs)
+
+2000-03-02 (feature enhancement) added %V substitution to entry widget
+validation to clarify type of validation occuring (hobbs)
+
+2000-03-29 (config enhancement) improved build support for gcc/mingw on
+Windows (nijtmans, hobbs) and added RPM target (melski)
+
+2000-03-24 (bug fixes) numerous corrections for more correct Unix dialog
+behaviors (melski)
+
+2000-03-27 (bug fix) fixed mem leak in wm commands (hu)
+
+2000-03-31 (bug fix) correct initialization of Windows static builds and
+added Unicode aware open/save file dialogs on Windows (hobbs)
+
+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)
+
+2000-04-07 (bug fix) correct font name length restriction that prevented
+the use of long named (>16 char) fonts on NT/2000 (hobbs)
+
+2000-04-07 (bug fix) fixed safe Tk to work in base cases (hobbs)
+
+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)
+
+2000-04-10 (bug fix) correctly check state of parent when popping up
+bgerror dialog. (melski)
+
+2000-04-11 (feature enhancement) msgcat now searches up the namespace chain
+for a match instead of just in the local namespace (hershey)
+
+2000-04-12 (bug fix) corrected handling of Windows clipboard to allow for
+use of user-defined types within the Tk app (hobbs)
+
+2000-04-13 (feature enhancement) improved handling of shadow determination
+for 3D borders in very light/dark cases (hipp, melski)
+
+2000-04-13 (bug fix) correctly color separator bg in menus on Windows
+(melski)
+
+2000-04-14 (bug fix) improved handling of scale widget, reduced number of
+redraws (hobbs)
+
+2000-04-17 (feature enhancement) made shift-selection more Windows-like
+(intuitive) in text widget (melski)
+
+2000-04-22 (bug fix) mac bug fixes, nav services handling (ingham)
+
+2000-04 more docs for public APIs (melski)
+
+--- Released 8.3.1, April 26, 2000 --- See ChangeLog for details ---
+
+2000-05-15 (bug fix) changed wm deiconify from using idle callback to
+calling restack and focus code immediately. (hobbs)
+
+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)
+
+2000-07 (build improvements) cleanup of the makefiles and configure scripts
+to correct support for building under gcc for Windows. (dejong)
+
+2000-08 (feature enhancements) for Windows, corrected drawing of separator
+menu entries, disable menu entries and the height for separator
+bars. (melski)
+
+2000-08 (bug fix) fixed calling of takeFocus proc with arg bearing
+functions. (nemethi)
+
+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)
+
+2000-08 (bug fix) Corrected code for using 'place', cursors, colors and 3D
+borders on multiple screens simultaneously. (hobbs, hipp)
+
+--- Released 8.3.2, August 9, 2000 --- See ChangeLog for details ---
diff --git a/tk/compat/limits.h b/tk/compat/limits.h
index 9487dac2200..cdeea13d40b 100644
--- a/tk/compat/limits.h
+++ b/tk/compat/limits.h
@@ -22,3 +22,4 @@
#define INT_MAX 0x7fffffff
#define SHRT_MIN 0x8000
#define SHRT_MAX 0x7fff
+
diff --git a/tk/compat/stdlib.h b/tk/compat/stdlib.h
index 0dabdaf8392..908d1fae288 100644
--- a/tk/compat/stdlib.h
+++ b/tk/compat/stdlib.h
@@ -9,7 +9,7 @@
* declare all the procedures needed here (such as strtod).
*
* Copyright (c) 1991 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
+ * 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.
@@ -43,3 +43,4 @@ extern unsigned long strtoul _ANSI_ARGS_((CONST char *string,
char **endPtr, int base));
#endif /* _STDLIB */
+
diff --git a/tk/compat/unistd.h b/tk/compat/unistd.h
index 1a13f585e63..1eb01cae482 100644
--- a/tk/compat/unistd.h
+++ b/tk/compat/unistd.h
@@ -82,3 +82,4 @@ extern int vfork _ANSI_ARGS_((void));
#endif /* _UNISTD */
+
diff --git a/tk/configure b/tk/configure
index f60a117eccd..131b608c790 100755
--- a/tk/configure
+++ b/tk/configure
@@ -28,6 +28,7 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
+sitefile=
srcdir=
target=NONE
verbose=
@@ -142,6 +143,7 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
+ --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -312,6 +314,11 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
+ -site-file | --site-file | --site-fil | --site-fi | --site-f)
+ ac_prev=sitefile ;;
+ -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+ sitefile="$ac_optarg" ;;
+
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -477,12 +484,16 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+if test -z "$sitefile"; then
+ if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
fi
+else
+ CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -548,7 +559,7 @@ else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
fi
echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:552: checking host system type" >&5
+echo "configure:563: checking host system type" >&5
host_alias=$host
case "$host_alias" in
@@ -570,7 +581,7 @@ echo "$ac_t""$host" 1>&6
case "${host}" in
-*-*-cygwin* | *-*-mingw32*)
+*cygwin* | *mingw32* | *windows32*)
CONFIGDIR="win"
;;
@@ -600,7 +611,7 @@ ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
esac
echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
-echo "configure:604: checking whether ${MAKE-make} sets \${MAKE}" >&5
+echo "configure:615: 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
diff --git a/tk/configure.in b/tk/configure.in
index f66718873c0..d8856d5b03f 100644
--- a/tk/configure.in
+++ b/tk/configure.in
@@ -11,7 +11,7 @@ AC_INIT(generic/tk.h)
AC_CANONICAL_HOST
case "${host}" in
-*-*-cygwin* | *-*-mingw32*)
+*cygwin* | *mingw32* | *windows32*)
CONFIGDIR="win"
AC_SUBST(CONFIGDIR)
;;
diff --git a/tk/cygtcl.m4 b/tk/cygtcl.m4
new file mode 100644
index 00000000000..b74c2be7aca
--- /dev/null
+++ b/tk/cygtcl.m4
@@ -0,0 +1,310 @@
+# CYGNUS LOCAL
+#
+# This entire file is Cygnus local, it contains a set of cross
+# platform autoconf macros to be used by Tcl extensions.
+
+# FIXME: There seems to be a problem with variable
+# names that still need an expansion (like $foo_FILE)
+# since another eval might be needed in these macros.
+
+#--------------------------------------------------------------------
+# TCL_TOOL_PATH
+#
+# Return a file path that the build system tool will understand.
+# This path might be different than the path used in the
+# Makefiles.
+#
+# Arguments:
+#
+# VAR
+# PATH
+#
+# Results:
+#
+#
+# Example:
+#
+# TCL_TOOL_PATH(TCL_CC_PATH, /usr/local/compiler)
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_PATH, [
+ val=$2
+
+ if test "$val" = "" ; then
+ AC_MSG_ERROR([Empty value for variable $1])
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ AC_MSG_ERROR([CYGPATH variable is not defined.])
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ $1=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ $1="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ $1=$val
+ ;;
+ esac
+])
+
+# FIXME: It would simplify things if no SUFFIX had to be passed
+# into these LONGNAME macros. Using the TCL_SHARED_LIB_SUFFIX
+# and TCL_UNSHARED_LIB_SUFFIX from tclConfig.sh might do the trick!
+
+#--------------------------------------------------------------------
+# TCL_TOOL_STATIC_LIB_LONGNAME
+#
+# Return static library name in the "long format" understood by
+# the build tools. This might involve prepending a suffix
+# and appending version information to the library name.
+#
+# Arguments:
+#
+# VAR
+# LIBNAME
+# SUFFIX
+#
+# Depends on:
+# TCL_DBGX
+# TCL_VENDOR_PREFIX
+#
+# Example:
+#
+# TCL_TOOL_STATIC_LIB_LONGNAME(TCL_LIB, tcl, $TCL_UNSHARED_LIB_SUFFIX)
+#
+# Results:
+#
+# TCL_LIB=libtcl83.a
+#
+# or
+#
+# TCL_LIB=tcl83.lib
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_STATIC_LIB_LONGNAME, [
+ libname=$2
+ suffix=$3
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ $1=$long_libname
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_SHARED_LIB_LONGNAME
+#
+# Return the shared library name in the "long format" understood by
+# the build tools. This might involve prepending a suffix
+# and appending version information to the shared library name.
+#
+# Arguments:
+#
+# VAR
+# LIBNAME
+# SUFFIX
+#
+# Depends on:
+# TCL_DBGX
+# TCL_VENDOR_PREFIX
+#
+# Example:
+#
+# TCL_TOOL_SHARED_LIB_LONGNAME(TCL_SHLIB, tcl, $TCL_SHARED_LIB_SUFFIX)
+#
+# Results:
+# The above example could result in the following.
+#
+# TCL_SHLIB=libtcl83.so
+#
+# or
+#
+# TCL_SHLIB=tcl83.dll
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_SHARED_LIB_LONGNAME, [
+ libname=$2
+ suffix=$3
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ $1=$long_libname
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_LIB_SHORTNAME
+#
+# Return the library name in the "short format" understood by
+# the build tools. This might involve prepending a suffix
+# and appending version information to the library name.
+# The VC++ compiler does not support short library names
+# so we just use the static import lib name in that case.
+#
+# Arguments:
+#
+# VAR
+# LIBNAME
+# VERSION
+#
+# Depends on:
+# TCL_LIB_VERSIONS_OK
+# TCL_DBGX
+# SHARED_BUILD
+#
+#
+# Example:
+#
+# TCL_TOOL_LIB_SHORTNAME(TCL_LIB, tcl, 8.3)
+#
+# Results:
+# The above example could result in the following.
+#
+# TCL_LIB=-ltcl83
+#
+# or
+#
+# TCL_LIB=tcl83.lib
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_LIB_SHORTNAME, [
+ libname=$2
+ version=$3
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ AC_MSG_ERROR([The TCL_LIB_SUFFIX variable is not defined])
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ $1=$short_libname
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_LIB_SPEC
+#
+# Return the "lib spec format" understood by the build tools.
+#
+# Arguments:
+#
+# VAR
+# DIR
+# LIBARG
+#
+# Depends on:
+#
+#
+# Example:
+#
+# TCL_TOOL_LIB_SPEC(SPEC, /usr/lib, -ltcl)
+#
+# Results:
+# The above example could result in the following.
+#
+# SPEC="-L/usr/lib -ltcl83"
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_LIB_SPEC, [
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ TCL_TOOL_PATH($1, "$2/$3")
+ else
+ TCL_TOOL_PATH(dirname, $2)
+ $1="-L${dirname} $3"
+ fi
+ ;;
+ *)
+ $1="-L$2 $3"
+ ;;
+ esac
+])
+
+#--------------------------------------------------------------------
+# TCL_TOOL_LIB_PATH
+#
+# Return the "lib path format" understood by the build tools.
+# Typically, this is the fully qualified path name of the library.
+#
+# Arguments:
+#
+# VAR
+# DIR
+# LIBARG
+#
+# Depends on:
+#
+#
+# Example:
+#
+# TCL_TOOL_LIB_PATH(TMP_PATH, /usr/lib, libtcl83.a)
+#
+# Results:
+# The above example could result in the following.
+#
+# TMP_PATH="/usr/lib/libtcl83.a"
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(TCL_TOOL_LIB_PATH, [
+ TCL_TOOL_PATH($1, "$2/$3")
+])
diff --git a/tk/doc/3DBorder.3 b/tk/doc/3DBorder.3
index 2916e8e1d2c..34482f08c08 100644
--- a/tk/doc/3DBorder.3
+++ b/tk/doc/3DBorder.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990-1993 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,17 +8,25 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_Get3DBorder 3 4.0 Tk "Tk Library Procedures"
+.TH Tk_Alloc3DBorderFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_Get3DBorder, Tk_Draw3DRectangle, Tk_Fill3DRectangle, Tk_Draw3DPolygon, Tk_Fill3DPolygon, Tk_3DVerticalBevel, Tk_3DHorizontalBevel, Tk_SetBackgroundFromBorder, Tk_NameOf3DBorder, Tk_3DBorderColor, Tk_3DBorderGC, Tk_Free3DBorder \- draw borders with three-dimensional appearance
+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
@@ -49,6 +57,10 @@ XColor *
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
@@ -57,10 +69,15 @@ Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window (for all procedures except \fBTk_Get3DBorder\fR,
must be the window for which the border was allocated).
-.AP Tk_Uid colorName in
-Textual description of color corresponding to background (flat areas).
-Illuminated edges will be brighter than this and shadowed edges will
-be darker than this.
+.AP 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
@@ -129,22 +146,42 @@ Must be TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or TK_3D_DARK_GC.
.SH DESCRIPTION
.PP
These procedures provide facilities for drawing window borders in a
-way that produces a three-dimensional appearance. \fBTk_Get3DBorder\fR
+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 \fIcolorName\fR
-argument indicates what colors should be used in the border.
-\fIColorName\fR may be any value acceptable to \fBTk_GetColor\fR.
-The color indicated by \fIcolorName\fR will not actually be used in
+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 \fIcolorName\fR, and the shadowed portions of the border will appear
-darker than \fIcolorName\fR.
+by \fIobjPtr\fR, and the shadowed portions of the border will appear
+darker than \fIobjPtr\fR.
.PP
-\fBTk_Get3DBorder\fR returns a token that may be used in later calls
+\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. \fIcolorName\fR isn't a legal color specifier),
+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.
@@ -171,7 +208,7 @@ a groove or ridge around the exterior of the rectangle.
\fBTk_Fill3DRectangle\fR is somewhat like \fBTk_Draw3DRectangle\fR except
that it first fills the rectangular area with the background color
(one corresponding
-to the \fIcolorName\fR used to create \fIborder\fR). Then it calls
+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
@@ -228,21 +265,19 @@ bottom bevel should be drawn with 0 for both arguments.
The procedure \fBTk_SetBackgroundFromBorder\fR will modify the background
pixel and/or pixmap of \fItkwin\fR to produce a result compatible
with \fIborder\fR. For color displays, the resulting background will
-just be the color given by the \fIcolorName\fR argument passed to
-\fBTk_Get3DBorder\fR when \fIborder\fR was created; for monochrome
+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 \fIcolorName\fR string that was passed to
-\fBTk_Get3DBorder\fR to create the border.
+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 \fIcolorName\fR passed to
-\fBTk_Get3DBorder\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
@@ -253,10 +288,19 @@ TK_3D_FLAT_GC returns the context used for flat surfaces,
TK_3D_LIGHT_GC returns the context for light shadows,
and TK_3D_DARK_GC returns the context for dark shadows.
.PP
-When a border is no longer needed, \fBTk_Free3DBorder\fR should
-be called to release the resources associated with the border.
-There should be exactly one call to \fBTk_Free3DBorder\fR for
-each call to \fBTk_Get3DBorder\fR.
+.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, polygon, raised, shadow, three-dimensional effect
+3D, background, border, color, depressed, illumination, object, polygon, raised, shadow, three-dimensional effect
+
diff --git a/tk/doc/AddOption.3 b/tk/doc/AddOption.3
new file mode 100644
index 00000000000..4aadf526a62
--- /dev/null
+++ b/tk/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 char *name in
+Multi-element name of option.
+.AP 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/tk/doc/BackgdErr.3 b/tk/doc/BackgdErr.3
new file mode 100644
index 00000000000..005f5b609b4
--- /dev/null
+++ b/tk/doc/BackgdErr.3
@@ -0,0 +1,58 @@
+'\"
+'\" Copyright (c) 1992-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) BackgdErr.3 1.3 96/03/25 19:56:51
+'\"
+.so man.macros
+.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_BackgroundError \- report Tcl error that occurred in background processing
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_BackgroundError\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Interpreter in which the error occurred.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is typically invoked when a Tcl error occurs during
+``background processing'' such as executing an event handler.
+When such an error occurs, the error condition is reported to Tcl
+or to a widget or some other C code, and there is not usually any
+obvious way for that code to report the error to the user.
+In these cases the code calls \fBTcl_BackgroundError\fR with an
+\fIinterp\fR argument identifying the interpreter in which the
+error occurred. At the time \fBTcl_BackgroundError\fR is invoked,
+\fIinterp->result\fR is expected to contain an error message.
+\fBTcl_BackgroundError\fR will invoke the \fBbgerror\fR
+Tcl command to report the error in an application-specific fashion.
+If no \fBbgerror\fR command exists, or if it returns with an error condition,
+then \fBTcl_BackgroundError\fR reports the error itself by printing
+a message on the standard error file.
+.PP
+\fBTcl_BackgroundError\fR does not invoke \fBbgerror\fR immediately
+because this could potentially interfere with scripts that are in process
+at the time the error occurred.
+Instead, it invokes \fBbgerror\fR later as an idle callback.
+\fBTcl_BackgroundError\fR saves the values of the \fBerrorInfo\fR and
+\fBerrorCode\fR variables and restores these values just before
+invoking \fBbgerror\fR.
+.PP
+It is possible for many background errors to accumulate before
+\fBbgerror\fR is invoked. When this happens, each of the errors
+is processed in order. However, if \fBbgerror\fR returns a
+break exception, then all remaining error reports for the
+interpreter are skipped.
+
+.SH KEYWORDS
+background, bgerror, error
diff --git a/tk/doc/BindTable.3 b/tk/doc/BindTable.3
index 5c0929893aa..bbfa74b41de 100644
--- a/tk/doc/BindTable.3
+++ b/tk/doc/BindTable.3
@@ -155,3 +155,4 @@ described in the documentation for \fBbind\fR.
.SH KEYWORDS
binding, event, object, script
+
diff --git a/tk/doc/CanvPsY.3 b/tk/doc/CanvPsY.3
index 9043a083212..3901af5dcf5 100644
--- a/tk/doc/CanvPsY.3
+++ b/tk/doc/CanvPsY.3
@@ -72,7 +72,7 @@ Most of the procedures take a \fIcanvas\fR argument, which
refers to a canvas widget for which Postscript is being
generated.
.PP
-\fBTk_CanvasY\fR takes as argument a y-coordinate in the space of
+\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
@@ -120,3 +120,4 @@ returned, unless an error occurs, in which case TCL_ERROR is returned and
.SH KEYWORDS
bitmap, canvas, color, font, path, Postscript, stipple
+
diff --git a/tk/doc/CanvTkwin.3 b/tk/doc/CanvTkwin.3
index 03315faa4ec..a35a0a5fc7c 100644
--- a/tk/doc/CanvTkwin.3
+++ b/tk/doc/CanvTkwin.3
@@ -159,3 +159,4 @@ static Tk_ConfigSpec configSpecs[] = {
.SH KEYWORDS
canvas, focus, item type, redisplay, selection, type manager
+
diff --git a/tk/doc/CanvTxtInfo.3 b/tk/doc/CanvTxtInfo.3
index 81d069a52dc..5eafcf565af 100644
--- a/tk/doc/CanvTxtInfo.3
+++ b/tk/doc/CanvTxtInfo.3
@@ -102,3 +102,4 @@ selection.
.SH KEYWORDS
canvas, focus, insertion cursor, selection, selection anchor, text
+
diff --git a/tk/doc/Clipboard.3 b/tk/doc/Clipboard.3
index 612c17ae0dc..573bd90d96e 100644
--- a/tk/doc/Clipboard.3
+++ b/tk/doc/Clipboard.3
@@ -78,3 +78,4 @@ any calling function should take care to be reentrant at the point
.SH KEYWORDS
append, clipboard, clear, format, type
+
diff --git a/tk/doc/ClrSelect.3 b/tk/doc/ClrSelect.3
index 1de0c1887b0..b40c4e56ddc 100644
--- a/tk/doc/ClrSelect.3
+++ b/tk/doc/ClrSelect.3
@@ -40,3 +40,4 @@ procedure has no effect.
.SH KEYWORDS
clear, selection
+
diff --git a/tk/doc/ConfigWidg.3 b/tk/doc/ConfigWidg.3
index 7ab3f67ef50..c558352eae1 100644
--- a/tk/doc/ConfigWidg.3
+++ b/tk/doc/ConfigWidg.3
@@ -26,10 +26,11 @@ 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
+.AS Tk_ConfigSpec *widgRec in/out
.AP Tcl_Interp *interp in
Interpreter to use for returning error messages.
.AP Tk_Window tkwin in
@@ -257,13 +258,13 @@ will never match any arguments.
.TP
\fBTK_CONFIG_FONT\fR
The value must be an ASCII string identifying a font in a form
-suitable for passing to \fBTk_GetFontStruct\fR. The value is converted
-to an (\fBXFontStruct *\fR) by calling \fBTk_GetFontStruct\fR and the result
+suitable for passing to \fBTk_GetFont\fR. The value is converted
+to an (\fBXFontStruct *\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_FreeFontStruct\fR.
+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
@@ -616,3 +617,4 @@ table that uses many of the fancy \fIspecFlags\fR mechanisms.
anchor, bitmap, boolean, border, cap style, color, configuration options,
cursor, custom, double, font, integer, join style, justify, millimeters,
pixels, relief, synonym, uid
+
diff --git a/tk/doc/ConfigWind.3 b/tk/doc/ConfigWind.3
index fd1c2c6919e..ae9c1da9480 100644
--- a/tk/doc/ConfigWind.3
+++ b/tk/doc/ConfigWind.3
@@ -151,3 +151,4 @@ Tk_MoveToplevelWindow, Tk_RestackWindow
.SH KEYWORDS
attributes, border, color, configure, height, pixel, pixmap, width, window, x, y
+
diff --git a/tk/doc/CoordToWin.3 b/tk/doc/CoordToWin.3
index 9cfd2ee5dc9..90467211417 100644
--- a/tk/doc/CoordToWin.3
+++ b/tk/doc/CoordToWin.3
@@ -49,3 +49,4 @@ both contain the point then the highest one in the stacking order
.SH KEYWORDS
containing, coordinates, root window
+
diff --git a/tk/doc/CrtErrHdlr.3 b/tk/doc/CrtErrHdlr.3
index 77495830332..58fee382f90 100644
--- a/tk/doc/CrtErrHdlr.3
+++ b/tk/doc/CrtErrHdlr.3
@@ -143,3 +143,4 @@ applications should use only \fBTk_CreateErrorHandler\fR.
.SH KEYWORDS
callback, error, event, handler
+
diff --git a/tk/doc/CrtGenHdlr.3 b/tk/doc/CrtGenHdlr.3
index c4d6609bfae..43aec19bec7 100644
--- a/tk/doc/CrtGenHdlr.3
+++ b/tk/doc/CrtGenHdlr.3
@@ -82,3 +82,4 @@ For example, it is the caller's responsibility to invoke
\fBXSelectInput\fR to select the desired events, if that is necessary.
.SH KEYWORDS
bind, callback, event, handler
+
diff --git a/tk/doc/CrtImgType.3 b/tk/doc/CrtImgType.3
index 7b9063da200..ebbae05ef3e 100644
--- a/tk/doc/CrtImgType.3
+++ b/tk/doc/CrtImgType.3
@@ -8,10 +8,10 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_CreateImageType 3 8.0 Tk "Tk Library Procedures"
+.TH Tk_CreateImageType 3 8.3 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_CreateImageType, Tk_GetImageMasterData \- define new kind of image
+Tk_CreateImageType, Tk_GetImageMasterData, Tk_InitImageArgs \- define new kind of image
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
@@ -21,6 +21,8 @@ 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
@@ -34,6 +36,10 @@ 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
+Number of arguments
+.AP char ***argvPtr
+Pointer to argument list
.VE
.BE
@@ -100,6 +106,16 @@ 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
@@ -109,8 +125,8 @@ an image of the new type.
typedef int Tk_ImageCreateProc(
Tcl_Interp *\fIinterp\fR,
char *\fIname\fR,
- int \fIargc\fR,
- char **\fIargv\fR,
+ int \fIobjc\fR,
+ Tcl_Obj *CONST \fIobjv\fR[],
Tk_ImageType *\fItypePtr\fR,
Tk_ImageMaster \fImaster\fR,
ClientData *\fImasterDataPtr\fR);
@@ -119,13 +135,13 @@ The \fIinterp\fR argument is the interpreter in which the \fBimage\fR
command was invoked, and \fIname\fR is the name for the new image,
which was either specified explicitly in the \fBimage\fR command
or generated automatically by the \fBimage\fR command.
-The \fIargc\fR and \fIargv\fR arguments describe all the configuration
+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 \fIargc\fR and \fIargv\fR
+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
@@ -248,8 +264,21 @@ 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/tk/doc/CrtItemType.3 b/tk/doc/CrtItemType.3
index 1dae46b55c9..4d839cdd13b 100644
--- a/tk/doc/CrtItemType.3
+++ b/tk/doc/CrtItemType.3
@@ -185,8 +185,8 @@ typedef int Tk_ItemCreateProc(
Tcl_Interp *\fIinterp\fR,
Tk_Canvas \fIcanvas\fR,
Tk_Item *\fIitemPtr\fR,
- int \fIargc\fR,
- char **\fIargv\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
@@ -195,17 +195,17 @@ handle for the canvas widget.
size \fItypePtr->itemSize\fR.
Tk has already initialized the item's header (the first
\fBsizeof(Tk_ItemType)\fR bytes).
-The \fIargc\fR and \fIargv\fR arguments describe all of the
+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
-\fIargc\fR will be \fB6\fR and \fIargv\fR[0] will contain the
-string \fB10\fR.
+\fIobjc\fR will be \fB6\fR and \fIobjv\fR[0] will contain the
+integer object \fB10\fR.
.PP
-\fIcreateProc\fR should use \fIargc\fR and \fIargv\fR to initialize
+\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
@@ -241,21 +241,21 @@ typedef int Tk_ItemConfigureProc(
Tcl_Interp *\fIinterp\fR,
Tk_Canvas \fIcanvas\fR,
Tk_Item *\fIitemPtr\fR,
- int \fIargc\fR,
- char **\fIargv\fR,
+ int \fIobjc\fR,
+ Tcl_Obj* CONST \fIobjv\fR,
int \fIflags\fR);
.CE
-The \fIinterp\fR argument identifies the interpreter in which the
+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.
-\fIargc\fR and \fIargv\fR contain the configuration options. For
+\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
-\fIargc\fR is \fB4\fR and \fIargv\fR contains the strings \fB\-fill\fR
+\fIobjc\fR is \fB4\fR and \fIobjv\fR contains the string objects \fB\-fill\fR
through \fBblack\fR.
-\fIargc\fR will always be an even value.
+\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
@@ -276,17 +276,17 @@ typedef int Tk_ItemCoordProc(
Tcl_Interp *\fIinterp\fR,
Tk_Canvas \fIcanvas\fR,
Tk_Item *\fIitemPtr\fR,
- int \fIargc\fR,
- char **\fIargv\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 \fIargc\fR and \fIargv\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
-\fIargc\fR will be \fB2\fR and \fBargv\fR will contain the string values
+\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,
@@ -442,7 +442,7 @@ In order to generate Postscript that complies with the Adobe Document
Structuring Conventions, Tk actually generates Postscript in two passes.
It calls each item's \fIpostscriptProc\fR in each pass.
The only purpose of the first pass is to collect font information
-(which is done by \fBTk_CanvPsFont\fR); the actual Postscript is
+(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
@@ -624,3 +624,5 @@ Tk_CanvasPsY, Tk_CanvasTextInfo, Tk_CanvasTkwin
.SH KEYWORDS
canvas, focus, item type, selection, type manager
+
+
diff --git a/tk/doc/CrtPhImgFmt.3 b/tk/doc/CrtPhImgFmt.3
index 7167d47ef51..c150267c563 100644
--- a/tk/doc/CrtPhImgFmt.3
+++ b/tk/doc/CrtPhImgFmt.3
@@ -12,7 +12,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_CreatePhotoImageFormat 3 4.0 Tk "Tk Library Procedures"
+.TH Tk_CreatePhotoImageFormat 3 8.3 Tk "Tk Library Procedures"
.BS
.SH NAME
Tk_CreatePhotoImageFormat \- define new file format for photo images
@@ -69,6 +69,14 @@ structure should be set to NULL. The handler must provide the
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.
@@ -76,7 +84,9 @@ 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.
+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
@@ -86,14 +96,15 @@ suitable for reading data in a given file.
.CS
typedef int Tk_ImageFileMatchProc(
Tcl_Channel \fIchan\fR,
- char *\fIfileName\fR,
- char *\fIformatString\fR,
+ CONST char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\fR,
int *\fIwidthPtr\fR,
- int *\fIheightPtr\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
-\fIformatString\fR argument contains the value given for 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
@@ -107,13 +118,14 @@ suitable for reading data from a given string.
\fIformatPtr->stringMatchProc\fR must match the following prototype:
.CS
typedef int Tk_ImageStringMatchProc(
- char *\fIstring\fR,
- char *\fIformatString\fR,
+ Tcl_Obj *\fIdata\fR,
+ Tcl_Obj *\fIformat\fR,
int *\fIwidthPtr\fR,
- int *\fIheightPtr\fR);
+ int *\fIheightPtr\fR,
+ Tcl_Interp *\fIinterp\fR);
.CE
-The \fIstring\fR argument points to the string containing the image
-data. The \fIformatString\fR argument contains the value given for
+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
@@ -129,8 +141,8 @@ Tk to call to read data from an image file into a photo image.
typedef int Tk_ImageFileReadProc(
Tcl_Interp *\fIinterp\fR,
Tcl_Channel \fIchan\fR,
- char *\fIfileName\fR,
- char *\fIformatString\fR,
+ CONST char *\fIfileName\fR,
+ Tcl_Obj *\fIformat\fR,
PhotoHandle \fIimageHandle\fR,
int \fIdestX\fR, int \fIdestY\fR,
int \fIwidth\fR, int \fIheight\fR,
@@ -139,7 +151,7 @@ typedef int Tk_ImageFileReadProc(
The \fIinterp\fR argument is the interpreter in which the command was
invoked to read the image; it should be used for reporting errors.
The image data is in the file named \fIfileName\fR, which is open for
-reading as \fIchan\fR. The \fIformatString\fR argument contains the
+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
@@ -157,8 +169,8 @@ Tk to call to read data from a string into a photo image.
.CS
typedef int Tk_ImageStringReadProc(
Tcl_Interp *\fIinterp\fR,
- char *\fIstring\fR,
- char *\fIformatString\fR,
+ Tcl_Obj *\fIdata\fR,
+ Tcl_Obj *\fIformat\fR,
PhotoHandle \fIimageHandle\fR,
int \fIdestX\fR, int \fIdestY\fR,
int \fIwidth\fR, int \fIheight\fR,
@@ -166,8 +178,8 @@ typedef int Tk_ImageStringReadProc(
.CE
The \fIinterp\fR argument is the interpreter in which the command was
invoked to read the image; it should be used for reporting errors.
-The \fIstring\fR argument points to the image data in string form.
-The \fIformatString\fR argument contains the
+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
@@ -185,8 +197,8 @@ Tk to call to write data from a photo image to a file.
.CS
typedef int Tk_ImageFileWriteProc(
Tcl_Interp *\fIinterp\fR,
- char *\fIfileName\fR,
- char *\fIformatString\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
@@ -195,7 +207,7 @@ The image data to be written are in memory and are described by the
Tk_PhotoImageBlock structure pointed to by \fIblockPtr\fR; see the
manual page FindPhoto(3) for details. The \fIfileName\fR argument
points to the string giving the name of the file in which to write the
-image data. The \fIformatString\fR argument contains the
+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
@@ -210,8 +222,7 @@ Tk to call to translate image data from a photo image into a string.
.CS
typedef int Tk_ImageStringWriteProc(
Tcl_Interp *\fIinterp\fR,
- Tcl_DString *\fIdataPtr\fR,
- char *\fIformatString\fR,
+ Tcl_Obj *\fIformat\fR,
Tk_PhotoImageBlock *\fIblockPtr\fR);
.CE
The \fIinterp\fR argument is the interpreter in which the command was
@@ -219,8 +230,8 @@ invoked to convert the image; it should be used for reporting errors.
The image data to be converted are in memory and are described by the
Tk_PhotoImageBlock structure pointed to by \fIblockPtr\fR; see the
manual page FindPhoto(3) for details. The data for the string
-should be appended to the dynamic string given by \fIdataPtr\fR.
-The \fIformatString\fR argument contains the
+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
@@ -233,3 +244,4 @@ Tk_FindPhoto, Tk_PhotoPutBlock
.SH KEYWORDS
photo image, image file
+
diff --git a/tk/doc/CrtSelHdlr.3 b/tk/doc/CrtSelHdlr.3
index 91d4dfbfe89..e8ec7a111a6 100644
--- a/tk/doc/CrtSelHdlr.3
+++ b/tk/doc/CrtSelHdlr.3
@@ -118,3 +118,4 @@ If there is no such handler then it has no effect.
.SH KEYWORDS
format, handler, selection, target
+
diff --git a/tk/doc/CrtWindow.3 b/tk/doc/CrtWindow.3
index 8c1074b7c54..4f477057618 100644
--- a/tk/doc/CrtWindow.3
+++ b/tk/doc/CrtWindow.3
@@ -125,7 +125,7 @@ created with \fBTk_CreateEventHandler\fR. In addition,
\fBTk_DestroyWindow\fR will delete any children of \fItkwin\fR
recursively (where children are defined in the Tk sense, consisting
of all windows that were created with the given window as \fIparent\fR).
-If \fItkwin\fR was created by \fBTk_CreateInternalWindow\fR then event
+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
@@ -140,3 +140,4 @@ the X commands to instantiate the window given by \fItkwin\fR.
.SH KEYWORDS
create, deferred creation, destroy, display, internal window,
screen, top-level window, window
+
diff --git a/tk/doc/DeleteImg.3 b/tk/doc/DeleteImg.3
index 9cadd680c1c..ddfd1f0a325 100644
--- a/tk/doc/DeleteImg.3
+++ b/tk/doc/DeleteImg.3
@@ -33,3 +33,4 @@ exist then the procedure has no effect.
.SH KEYWORDS
delete image, image manager
+
diff --git a/tk/doc/DoOneEvent.3 b/tk/doc/DoOneEvent.3
new file mode 100644
index 00000000000..fd092c8b8c2
--- /dev/null
+++ b/tk/doc/DoOneEvent.3
@@ -0,0 +1,108 @@
+'\"
+'\" Copyright (c) 1990-1992 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) DoOneEvent.3 1.6 97/05/09 18:12:05
+'\"
+.so man.macros
+.TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DoOneEvent \- wait for events and invoke event handlers
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+int
+\fBTcl_DoOneEvent\fR(\fIflags\fR)
+.SH ARGUMENTS
+.AS int flags
+.AP int flags in
+This parameter is normally zero. It may be an OR-ed combination
+of any of the following flag bits:
+TCL_WINDOW_EVENTS,
+TCL_FILE_EVENTS, TCL_TIMER_EVENTS, TCL_IDLE_EVENTS, TCL_ALL_EVENTS, or
+TCL_DONT_WAIT.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is the entry point to Tcl's event loop; it is responsible for
+waiting for events and dispatching event handlers created with
+procedures such as \fBTk_CreateEventHandler\fR, \fBTcl_CreateFileHandler\fR,
+\fBTcl_CreateTimerHandler\fR, and \fBTcl_DoWhenIdle\fR.
+\fBTcl_DoOneEvent\fR checks to see if
+events are already present on the Tcl event queue; if so,
+it calls the handler(s) for the first (oldest) event, removes it from
+the queue, and returns.
+If there are no events ready to be handled, then \fBTcl_DoOneEvent\fR
+checks for new events from all possible sources.
+If any are found, it puts all of them on Tcl's event queue, calls
+handlers for the first event on the queue, and returns.
+If no events are found, \fBTcl_DoOneEvent\fR checks for \fBTcl_DoWhenIdle\fR
+callbacks; if any are found, it invokes all of them and returns.
+Finally, if no events or idle callbacks have been found, then
+\fBTcl_DoOneEvent\fR sleeps until an event occurs; then it adds any
+new events to the Tcl event queue, calls handlers for the first event,
+and returns.
+The normal return value is 1 to signify that some event
+was processed (see below for other alternatives).
+.PP
+If the \fIflags\fR argument to \fBTcl_DoOneEvent\fR is non-zero,
+it restricts the kinds of events that will be processed by
+\fBTcl_DoOneEvent\fR.
+\fIFlags\fR may be an OR-ed combination of any of the following bits:
+.TP 27
+\fBTCL_WINDOW_EVENTS\fR \-
+Process window system events.
+.TP 27
+\fBTCL_FILE_EVENTS\fR \-
+Process file events.
+.TP 27
+\fBTCL_TIMER_EVENTS\fR \-
+Process timer events.
+.TP 27
+\fBTCL_IDLE_EVENTS\fR \-
+Process idle callbacks.
+.TP 27
+\fBTCL_ALL_EVENTS\fR \-
+Process all kinds of events: equivalent to OR-ing together all of the
+above flags or specifying none of them.
+.TP 27
+\fBTCL_DONT_WAIT\fR \-
+Don't sleep: process only events that are ready at the time of the
+call.
+.LP
+If any of the flags \fBTCL_WINDOW_EVENTS\fR, \fBTCL_FILE_EVENTS\fR,
+\fBTCL_TIMER_EVENTS\fR, or \fBTCL_IDLE_EVENTS\fR is set, then the only
+events that will be considered are those for which flags are set.
+Setting none of these flags is equivalent to the value
+\fBTCL_ALL_EVENTS\fR, which causes all event types to be processed.
+If an application has defined additional event sources with
+\fBTcl_CreateEventSource\fR, then additional \fIflag\fR values
+may also be valid, depending on those event sources.
+.PP
+The \fBTCL_DONT_WAIT\fR flag causes \fBTcl_DoOneEvent\fR not to put
+the process to sleep: it will check for events but if none are found
+then it returns immediately with a return value of 0 to indicate
+that no work was done.
+\fBTcl_DoOneEvent\fR will also return 0 without doing anything if
+the only alternative is to block forever (this can happen, for example,
+if \fIflags\fR is \fBTCL_IDLE_EVENTS\fR and there are no
+\fBTcl_DoWhenIdle\fR callbacks pending, or if no event handlers or
+timer handlers exist).
+.PP
+\fBTcl_DoOneEvent\fR may be invoked recursively. For example,
+it is possible to invoke \fBTcl_DoOneEvent\fR recursively
+from a handler called by \fBTcl_DoOneEvent\fR. This sort
+of operation is useful in some modal situations, such
+as when a
+notification dialog has been popped up and an application wishes to
+wait for the user to click a button in the dialog before
+doing anything else.
+
+.SH KEYWORDS
+callback, event, handler, idle, timer
diff --git a/tk/doc/DoWhenIdle.3 b/tk/doc/DoWhenIdle.3
new file mode 100644
index 00000000000..c909026d6c9
--- /dev/null
+++ b/tk/doc/DoWhenIdle.3
@@ -0,0 +1,86 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) DoWhenIdle.3 1.6 97/05/09 18:18:33
+'\"
+.so man.macros
+.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR)
+.sp
+\fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR)
+.SH ARGUMENTS
+.AS Tcl_IdleProc clientData
+.AP Tcl_IdleProc *proc in
+Procedure to invoke.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
+when the application becomes idle. The application is
+considered to be idle when \fBTcl_DoOneEvent\fR has been
+called, couldn't find any events to handle, and is about
+to go to sleep waiting for an event to occur. At this
+point all pending \fBTcl_DoWhenIdle\fR handlers are
+invoked. For each call to \fBTcl_DoWhenIdle\fR there will
+be a single call to \fIproc\fR; after \fIproc\fR is
+invoked the handler is automatically removed.
+\fBTcl_DoWhenIdle\fR is only usable in programs that
+use \fBTcl_DoOneEvent\fR to dispatch events.
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTcl_IdleProc\fR:
+.CS
+typedef void Tcl_IdleProc(ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
+argument given to \fBTcl_DoWhenIdle\fR. Typically, \fIclientData\fR
+points to a data structure containing application-specific information about
+what \fIproc\fR should do.
+.PP
+\fBTcl_CancelIdleCall\fR
+may be used to cancel one or more previous
+calls to \fBTcl_DoWhenIdle\fR: if there is a \fBTcl_DoWhenIdle\fR
+handler registered for \fIproc\fR and \fIclientData\fR, then it
+is removed without invoking it. If there is more than one
+handler on the idle list that refers to \fIproc\fR and \fIclientData\fR,
+all of the handlers are removed. If no existing handlers match
+\fIproc\fR and \fIclientData\fR then nothing happens.
+.PP
+\fBTcl_DoWhenIdle\fR is most useful in situations where
+(a) a piece of work will have to be done but (b) it's
+possible that something will happen in the near future
+that will change what has to be done or require something
+different to be done. \fBTcl_DoWhenIdle\fR allows the
+actual work to be deferred until all pending events have
+been processed. At this point the exact work to be done
+will presumably be known and it can be done exactly once.
+.PP
+For example, \fBTcl_DoWhenIdle\fR might be used by an editor
+to defer display updates until all pending commands have
+been processed. Without this feature, redundant redisplays
+might occur in some situations, such as the processing of
+a command file.
+.SH BUGS
+.PP
+At present it is not safe for an idle callback to reschedule itself
+continuously. This will interact badly with certain features of Tk
+that attempt to wait for all idle callbacks to complete. If you would
+like for an idle callback to reschedule itself continuously, it is
+better to use a timer handler with a zero timeout period.
+
+.SH KEYWORDS
+callback, defer, idle callback
diff --git a/tk/doc/DrawFocHlt.3 b/tk/doc/DrawFocHlt.3
index ec77a675737..b3d810d1769 100644
--- a/tk/doc/DrawFocHlt.3
+++ b/tk/doc/DrawFocHlt.3
@@ -15,7 +15,7 @@ Tk_DrawFocusHighlight \- draw the traversal highlight ring for a widget
.nf
\fB#include <tk.h>\fR
.sp
-\fBTk_GetPixels(\fItkwin, gc, width, drawable\fB)\fR
+\fBTk_DrawFocusHighlight(\fItkwin, gc, width, drawable\fB)\fR
.SH ARGUMENTS
.AS "Tcl_Interp" *joinPtr
.AP Tk_Window tkwin in
@@ -38,3 +38,5 @@ It is typically invoked by widgets during redisplay.
.SH KEYWORDS
focus, traversal highlight
+
+
diff --git a/tk/doc/EventHndlr.3 b/tk/doc/EventHndlr.3
index b17adc20cac..a77d957f231 100644
--- a/tk/doc/EventHndlr.3
+++ b/tk/doc/EventHndlr.3
@@ -63,7 +63,7 @@ specified in the \fImask\fR argument to \fBTk_CreateEventHandler\fR.
previously-created event handler: it deletes the first handler
it finds that is associated with \fItkwin\fR and matches the
\fImask\fR, \fIproc\fR, and \fIclientData\fR arguments. If
-no such handler exists, then \fBTk_EventHandler\fR returns
+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.
@@ -77,3 +77,4 @@ order they were created.
.SH KEYWORDS
bind, callback, event, handler
+
diff --git a/tk/doc/FindPhoto.3 b/tk/doc/FindPhoto.3
index 8cd20f2c534..1d6b5468aad 100644
--- a/tk/doc/FindPhoto.3
+++ b/tk/doc/FindPhoto.3
@@ -119,7 +119,7 @@ typedef struct {
int \fIheight\fR;
int \fIpitch\fR;
int \fIpixelSize\fR;
- int \fIoffset[3]\fR;
+ int \fIoffset[4]\fR;
} Tk_PhotoImageBlock;
.CE
The \fIpixelPtr\fR field points to the first pixel, that is, the
@@ -130,10 +130,10 @@ difference between two horizontally adjacent pixels. Often it is 3
or 4, but it can have any value. The \fIpitch\fR field specifies the
address difference between two vertically adjacent pixels. The
\fIoffset\fR array contains the offsets from the address of a pixel
-to the addresses of the bytes containing the red, green and blue
-components. These are normally 0, 1 and 2, but can have other values,
-e.g., for images that are stored as separate red, green and blue
-planes.
+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
The value given for the \fIwidth\fR and \fIheight\fR parameters to
\fBTk_PhotoPutBlock\fR do not have to correspond to the values specified
@@ -200,3 +200,4 @@ based on his earlier photo widget code.
.SH KEYWORDS
photo, image
+
diff --git a/tk/doc/FontId.3 b/tk/doc/FontId.3
index 4cfdb410247..fc7bd83795d 100644
--- a/tk/doc/FontId.3
+++ b/tk/doc/FontId.3
@@ -93,3 +93,4 @@ other line.
.VE
.SH KEYWORDS
font
+
diff --git a/tk/doc/FreeXId.3 b/tk/doc/FreeXId.3
index 3399d083225..a9cb1fb8d36 100644
--- a/tk/doc/FreeXId.3
+++ b/tk/doc/FreeXId.3
@@ -37,7 +37,7 @@ allows identifiers to be reused.
In order for this to work, \fBTk_FreeXId\fR must be called to
tell the allocator about resources that have been freed.
Tk automatically calls \fBTk_FreeXId\fR whenever it frees a
-resource, so if you use procedures like \fBTk_GetFontStruct\fR,
+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
@@ -50,3 +50,4 @@ to lose all of the available identifiers.
.SH KEYWORDS
resource identifier
+
diff --git a/tk/doc/GeomReq.3 b/tk/doc/GeomReq.3
index cf6bf6579fb..6bdd459c600 100644
--- a/tk/doc/GeomReq.3
+++ b/tk/doc/GeomReq.3
@@ -67,3 +67,4 @@ See the \fBTk_WindowId\fR manual entry for details.
.SH KEYWORDS
geometry, request
+
diff --git a/tk/doc/GetAnchor.3 b/tk/doc/GetAnchor.3
index 08af4d15f98..3c1f7cb3e6b 100644
--- a/tk/doc/GetAnchor.3
+++ b/tk/doc/GetAnchor.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,14 +8,19 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetAnchor 3 "" Tk "Tk Library Procedures"
+.TH Tk_GetAnchorFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetAnchor, Tk_NameOfAnchor \- translate between strings and anchor positions
+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
@@ -24,35 +29,52 @@ char *
.SH ARGUMENTS
.AS "Tk_Anchor" *anchorPtr
.AP Tcl_Interp *interp in
-Interpreter to use for error reporting.
+Interpreter to use for error reporting, or NULL.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value contains name of anchor point: \fBn\fR, \fBne\fR,
+\fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR;
+internal rep will be modified to cache corresponding Tk_Anchor.
.AP char *string in
-String containing name of anchor point: one of ``n'', ``ne'', ``e'', ``se'',
-``s'', ``sw'', ``w'', ``nw'', or ``center''.
+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
-\fIstring\fR.
+\fIobjPtr\fR or \fIstring\fR.
.AP Tk_Anchor anchor in
Anchor position, e.g. \fBTCL_ANCHOR_CENTER\fR.
.BE
.SH DESCRIPTION
.PP
-\fBTk_GetAnchor\fR places in \fI*anchorPtr\fR an anchor position
+.VS 8.1
+\fBTk_GetAnchorFromObj\fR places in \fI*anchorPtr\fR an anchor position
(enumerated type \fBTk_Anchor\fR)
-corresponding to \fIstring\fR, which will be one of
+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 that object, e.g. \fBTK_ANCHOR_N\fR means
+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, then an error message is
-stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and
-\fI*anchorPtr\fR is unmodified.
+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
@@ -62,3 +84,4 @@ If \fIanchor\fR isn't a legal anchor value, then
.SH KEYWORDS
anchor position
+
diff --git a/tk/doc/GetBitmap.3 b/tk/doc/GetBitmap.3
index 282382af765..4705b95b6f4 100644
--- a/tk/doc/GetBitmap.3
+++ b/tk/doc/GetBitmap.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,35 +8,54 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetBitmap 3 8.0 Tk "Tk Library Procedures"
+.TH Tk_AllocBitmapFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetBitmap, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmap, Tk_GetBitmapFromData \- maintain database of single-plane pixmaps
+Tk_AllocBitmapFromObj, Tk_GetBitmap, Tk_GetBitmapFromObj, Tk_DefineBitmap, Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeBitmapFromObj, Tk_FreeBitmap, Tk_GetBitmapFromData \- maintain database of single-plane pixmaps
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
+.VS 8.1
Pixmap
-\fBTk_GetBitmap(\fIinterp, tkwin, id\fB)\fR
+\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, nameId, source, width, height\fB)\fR
+\fBTk_DefineBitmap(\fIinterp, name, source, width, height\fB)\fR
.sp
-Tk_Uid
+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.
+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.
-.AP Tk_Uid id in
-Description of bitmap; see below for possible values.
-.AP Tk_Uid nameId in
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value describes desired bitmap; internal rep will be
+modified to cache pointer to corresponding Pixmap.
+.AP "CONST char" *info in
+Same as \fIobjPtr\fR except description of bitmap is passed as a string and
+resulting Pixmap isn't cached.
+.VE
+.AP "CONST char" *name in
Name for new bitmap to be defined.
.AP char *source in
Data for bitmap, in standard bitmap format.
@@ -52,7 +71,8 @@ Pointer to word to fill in with \fIbitmap\fR's height.
.AP Display *display in
Display for which \fIbitmap\fR was allocated.
.AP Pixmap bitmap in
-Identifier for a bitmap allocated by \fBTk_GetBitmap\fR.
+Identifier for a bitmap allocated by \fBTk_AllocBitmapFromObj\fR or
+\fBTk_GetBitmap\fR.
.BE
.SH DESCRIPTION
@@ -62,11 +82,13 @@ being used by an application. The procedures allow bitmaps to be
re-used efficiently, thereby avoiding server overhead, and also
allow bitmaps to be named with character strings.
.PP
-\fBTk_GetBitmap\fR takes as argument a Tk_Uid describing a bitmap.
-It returns a Pixmap identifier for a bitmap corresponding to the
-description. It re-uses an existing bitmap, if possible, and
-creates a new one otherwise. At present, \fIid\fR must have
-one of the following forms:
+.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
@@ -166,15 +188,35 @@ A face with ballon words.
A triangle with an exclamation point.
.RE
.LP
-Under normal conditions, \fBTk_GetBitmap\fR
+.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 \fIid\fR refers
+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->result\fR.
+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_GetBitmap\fR. The \fInameId\fR
+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
@@ -186,7 +228,8 @@ TCL_ERROR is returned and an error message is left in
Note: \fBTk_DefineBitmap\fR expects the memory pointed to by
\fIsource\fR to be static: \fBTk_DefineBitmap\fR doesn't make
a private copy of this memory, but uses the bytes pointed to
-by \fIsource\fR later in calls to \fBTk_GetBitmap\fR.
+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
@@ -196,36 +239,40 @@ 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, Tk_GetUid("foo"), stip_bits,
+Tk_DefineBitmap(interp, "foo", stip_bits,
stip_width, stip_height);
\&...
-bitmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid("foo"));
+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, Tk_GetUid("@stip.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
-\fBTk_GetBitmap\fR maintains a
-database of all the bitmaps that are currently in use.
+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_GetBitmap\fR should generally be used in preference to Xlib
-procedures like \fBXReadBitmapFile\fR.
+\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_GetBitmap\fR
+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
@@ -233,28 +280,33 @@ or \fBXCreatePixmap\fR directly.
.PP
The procedure \fBTk_NameOfBitmap\fR is roughly the inverse of
\fBTk_GetBitmap\fR.
-Given an X Pixmap argument, it returns the \fIid\fR that was
+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_GetBitmap\fR.
+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_GetBitmap\fR.
+\fIbitmap\fR must have been created by \fBTk_AllocBitmapFromObj\fR or
+\fBTk_GetBitmap\fR.
.PP
-When a bitmap returned by \fBTk_GetBitmap\fR
-is no longer needed, \fBTk_FreeBitmap\fR should be called to release it.
-There should be exactly one call to \fBTk_FreeBitmap\fR for
-each call to \fBTk_GetBitmap\fR.
-When a bitmap is no longer in use anywhere (i.e. it has been freed as
-many times as it has been gotten) \fBTk_FreeBitmap\fR will release
-it to the X server and delete it from the database.
+.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_GetBitmap\fR
-considers only the immediate value of its \fIid\fR argument. For
+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
@@ -264,3 +316,4 @@ a different file.
.SH KEYWORDS
bitmap, pixmap
+
diff --git a/tk/doc/GetCapStyl.3 b/tk/doc/GetCapStyl.3
index c8c000793a8..0e847473d62 100644
--- a/tk/doc/GetCapStyl.3
+++ b/tk/doc/GetCapStyl.3
@@ -61,3 +61,4 @@ If \fIcap\fR isn't a legal cap style, then
.SH KEYWORDS
butt, cap style, projecting, round
+
diff --git a/tk/doc/GetClrmap.3 b/tk/doc/GetClrmap.3
index 936dbff568b..ce94295c3df 100644
--- a/tk/doc/GetClrmap.3
+++ b/tk/doc/GetClrmap.3
@@ -71,3 +71,4 @@ name as \fIstring\fR.
.SH KEYWORDS
colormap
+
diff --git a/tk/doc/GetColor.3 b/tk/doc/GetColor.3
index afd8a74eac1..178dafe3820 100644
--- a/tk/doc/GetColor.3
+++ b/tk/doc/GetColor.3
@@ -1,6 +1,6 @@
'\"
-'\" Copyright (c) 1990, 1991 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,25 +8,37 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetColor 3 4.0 Tk "Tk Library Procedures"
+.TH Tk_AllocColorFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetColor, Tk_GetColorByValue, Tk_NameOfColor, Tk_FreeColor \- maintain database of colors
+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_GetColor\fR(\fIinterp, tkwin, nameId\fB)\fR
+\fBTk_AllocColorFromObj(\fIinterp, tkwin, objPtr\fB)\fR
.sp
XColor *
-\fBTk_GetColorByValue\fR(\fItkwin, prefPtr\fB)\fR
+\fBTk_GetColor(\fIinterp, tkwin, name\fB)\fR
+.sp
+XColor *
+\fBTk_GetColorFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
+XColor *
+\fBTk_GetColorByValue(\fItkwin, prefPtr\fB)\fR
.sp
char *
\fBTk_NameOfColor(\fIcolorPtr\fB)\fR
.sp
GC
-\fBTk_GCForColor\fR(\fIcolorPtr, drawable\fR)
+\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
@@ -35,27 +47,39 @@ GC
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window in which color will be used.
-.AP Tk_Uid nameId in
-Textual description of desired color.
+.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_GetColor\fR or \fBTk_GetColorByValue\fR, except when passed
-to \fBTk_NameOfColor\fR.
+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
-The \fBTk_GetColor\fR and \fBTk_GetColorByValue\fR procedures
-locate pixel values that may be used to render particular
-colors in the window given by \fItkwin\fR. In \fBTk_GetColor\fR
-the desired color is specified with a Tk_Uid (\fInameId\fR), which
-may have any of the following forms:
+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
@@ -76,38 +100,56 @@ When fewer than 16 bits are provided for each color, they represent
the most significant bits of the color. For example, #3a7 is the
same as #3000a0007000.
.PP
-In \fBTk_GetColorByValue\fR, the desired color is indicated with
-the \fIred\fR, \fIgreen\fR, and \fIblue\fR fields of the structure
-pointed to by \fIcolorPtr\fR.
-.PP
-If \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR is successful
-in allocating the desired color, then it returns a pointer to
+.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 in the color.
-If the colormap for \fItkwin\fR is full, \fBTk_GetColor\fR
-and \fBTk_GetColorByValue\fR will use the closest existing color
-in the colormap.
-If \fBTk_GetColor\fR encounters an error while allocating
-the color (such as an unknown color name) then NULL is returned and
-an error message is stored in \fIinterp->result\fR;
-\fBTk_GetColorByValue\fR never returns an error.
+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_GetColor\fR and \fBTk_GetColorByValue\fR maintain a database
+\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 \fInameId\fR is requested multiple times from
-\fBTk_GetColor\fR (e.g. by different windows), or if the
+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 X server, which makes the allocation much more
-efficient. For this reason, you should generally use
-\fBTk_GetColor\fR or \fBTk_GetColorByValue\fR
-instead of Xlib procedures like \fBXAllocColor\fR,
-\fBXAllocNamedColor\fR, or \fBXParseColor\fR.
+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 \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR
+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.
@@ -116,15 +158,16 @@ If you need to change a color value dynamically, you should use
.PP
The procedure \fBTk_NameOfColor\fR is roughly the inverse of
\fBTk_GetColor\fR. If its \fIcolorPtr\fR argument was created
-by \fBTk_GetColor\fR, then the return value is the \fInameId\fR
-string that was passed to \fBTk_GetColor\fR to create the
+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.
+only guaranteed to persist until the next call to
+\fBTk_NameOfColor\fR.
.PP
-\fBTk_GCForColor\fR returns a graphics context whose \fBForeground\fR
+\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.
@@ -132,15 +175,17 @@ The graphics context is cached with the color and will exist only as
long as \fIcolorPtr\fR exists; it is freed when the last reference
to \fIcolorPtr\fR is freed by calling \fBTk_FreeColor\fR.
.PP
-When a pixel value returned by \fBTk_GetColor\fR or
-\fBTk_GetColorByValue\fR is no longer
-needed, \fBTk_FreeColor\fR should be called to release the color.
-There should be exactly one call to \fBTk_FreeColor\fR for
-each call to \fBTk_GetColor\fR or \fBTk_GetColorByValue\fR.
-When a pixel value is no longer in
-use anywhere (i.e. it has been freed as many times as it has been gotten)
-\fBTk_FreeColor\fR will release it to the X server and delete it from
-the database.
-
+.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, pixel value
+color, intensity, object, pixel value
+
diff --git a/tk/doc/GetCursor.3 b/tk/doc/GetCursor.3
index d5fb0a574c4..a0a3bcb350c 100644
--- a/tk/doc/GetCursor.3
+++ b/tk/doc/GetCursor.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,16 +8,24 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetCursor 3 4.1 Tk "Tk Library Procedures"
+.TH Tk_AllocCursorFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetCursor, Tk_GetCursorFromData, Tk_NameOfCursor, Tk_FreeCursor \- maintain database of cursors
+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_GetCursor(\fIinterp, tkwin, nameId\fB)\fR
+\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
@@ -25,6 +33,10 @@ Tk_Cursor
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
@@ -32,12 +44,18 @@ char *
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Token for window in which the cursor will be used.
-.AP Tk_Uid nameId in
-Description of cursor; see below for possible values.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+Description of cursor; see below for possible values. Internal rep will be
+modified to cache pointer to corresponding Tk_Cursor.
+.AP char *name in
+Same as \fIobjPtr\fR except description of cursor is passed as a string and
+resulting Tk_Cursor isn't cached.
+.VE
.AP char *source in
-Data for cursor bitmap, in standard bitmap format.
+Data for cursor cursor, in standard cursor format.
.AP char *mask in
-Data for mask bitmap, in standard bitmap format.
+Data for mask cursor, in standard cursor format.
.AP "int" width in
Width of \fIsource\fR and \fImask\fR.
.AP "int" height in
@@ -53,7 +71,7 @@ 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
+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
@@ -63,18 +81,25 @@ have been returned by some previous call to \fBTk_GetCursor\fR or
These procedures manage a collection of cursors
being used by an application. The procedures allow cursors to be
re-used efficiently, thereby avoiding server overhead, and also
-allow cursors to be named with character strings (actually Tk_Uids).
+allow cursors to be named with character strings.
.PP
-\fBTk_GetCursor\fR takes as argument a Tk_Uid describing a cursor,
-and returns an opaque Tk identifier for a cursor corresponding to the
-description.
-It re-uses an existing cursor if possible and
-creates a new one otherwise. \fINameId\fR must be a standard Tcl
+.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 font,
-i.e., any of the names defined in \fBcursorfont.h\fR, without
+\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
@@ -86,9 +111,10 @@ will be no background color: the background will be transparent.
If no colors are specified, then the cursor
will use black for its foreground color and white for its background
color.
-
-The Macintosh version of Tk also supports all of the X cursors.
-Tk on the Mac will also accept any of the standard Mac cursors
+.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
@@ -96,11 +122,12 @@ 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 bitmaps for the cursor's source bits and mask.
-Each file must be in standard X11 or X10 bitmap format.
+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
@@ -111,11 +138,33 @@ 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 bitmaps. \fISource\fR
-points to standard bitmap data for the cursor's source bits, and
-\fImask\fR points to standard bitmap data describing
+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
@@ -135,24 +184,26 @@ cursor = Tk_GetCursorFromData(interp, tkwin, source_bits,
source_y_hot, Tk_GetUid("red"), Tk_GetUid("blue"));
.CE
.PP
-Under normal conditions, \fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR
+Under normal conditions \fBTk_GetCursorFromData\fR
will return an identifier for the requested cursor. If an error
-occurs in creating the cursor, such as when \fInameId\fR refers
-to a non-existent file, then \fBNone\fR is returned and an error
-message will be stored in \fIinterp->result\fR.
+occurs in creating the cursor then \fBNone\fR is returned and an error
+message will be stored in \fIinterp\fR's result.
.PP
-\fBTk_GetCursor\fR and \fBTk_GetCursorFromData\fR maintain a
+\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_GetCursor\fR or \fBTk_GetCursorFromData\fR will
+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.
+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 \fInameId\fR
+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
@@ -162,17 +213,24 @@ only guaranteed to persist until the next call to
\fBTk_NameOfCursor\fR. Also, this call is not portable except for
cursors returned by \fBTk_GetCursor\fR.
.PP
-When a cursor returned by \fBTk_GetCursor\fR or \fBTk_GetCursorFromData\fR
-is no longer needed, \fBTk_FreeCursor\fR should be called to release it.
+.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_GetCursor\fR or \fBTk_GetCursorFromData\fR.
-When a cursor is no longer in use anywhere (i.e. it has been freed as
-many times as it has been gotten) \fBTk_FreeCursor\fR will release
-it to the X server and remove it from the database.
+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_GetCursor\fR and \fBTk_GetCursorFromData\fR
+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
@@ -186,3 +244,4 @@ see if the actual data values have changed.
.SH KEYWORDS
cursor
+
diff --git a/tk/doc/GetDash.3 b/tk/doc/GetDash.3
new file mode 100644
index 00000000000..c7e0f8a43a3
--- /dev/null
+++ b/tk/doc/GetDash.3
@@ -0,0 +1,71 @@
+'\"
+'\" 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/tk/doc/GetFont.3 b/tk/doc/GetFont.3
index 1547db0934b..1df9fc26ad5 100644
--- a/tk/doc/GetFont.3
+++ b/tk/doc/GetFont.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,67 +8,116 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetFont 3 "" Tk "Tk Library Procedures"
+.TH Tk_AllocFontFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetFont, Tk_NameOfFont, Tk_FreeFont \- maintain database of fonts
+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_GetFont(\fIinterp, tkwin, string\fB)\fR
+\fBTk_AllocFontFromObj(\fIinterp, tkwin, objPtr\fB)\fR
+.sp
+Tk_Font
+\fBTk_GetFont(\fIinterp, tkwin, string\fB)\fR
+.sp
+Tk_Font
+\fBTk_GetFontFromObj(\fItkwin, objPtr\fB)\fR
+.VE
.sp
char *
\fBTk_NameOfFont(\fItkfont\fB)\fR
.sp
+.VS 8.1
+Tk_Font
+\fBTk_FreeFontFromObj(\fItkwin, objPtr\fB)\fR
+.VE
+.sp
void
\fBTk_FreeFont(\fItkfont\fB)\fR
.SH ARGUMENTS
.AS "const char" *tkfont
.AP "Tcl_Interp" *interp in
-Interpreter to use for error reporting.
+Interpreter to use for error reporting. If NULL, then no error
+messages are left after errors.
.AP Tk_Window tkwin in
-Token for window on the display in which font will be used.
+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
-Name or description of desired font. See documentation for the \fBfont\fR
-command for details on acceptable formats.
+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
-\fBTk_GetFont\fR finds the font indicated by \fIstring\fR and returns a
-token that represents the font. The return value can be used in subsequent
-calls to procedures such as \fBTk_FontMetrics\fR, \fBTk_MeasureChars\fR, and
-\fBTk_FreeFont\fR. The token returned by \fBTk_GetFont\fR will remain
-valid until \fBTk_FreeFont\fR is called to release it. \fIString\fR can
-be either a symbolic name or a font description; see the documentation for
-the \fBfont\fR command for a description of the valid formats. If
-\fBTk_GetFont\fR is unsuccessful (because, for example, \fIstring\fR was
-not a valid font specification) then it returns \fBNULL\fR and stores an
-error message in \fIinterp->result\fR.
+.VS 8.1
+\fBTk_AllocFontFromObj\fR finds the font indicated by \fIobjPtr\fR and
+returns a token that represents the font. The return value can be used
+in subsequent calls to procedures such as \fBTk_FontMetrics\fR,
+\fBTk_MeasureChars\fR, and \fBTk_FreeFont\fR. The Tk_Font token
+will remain valid until
+\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR is called to release it.
+\fIObjPtr\fR can contain either a symbolic name or a font description; see
+the documentation for the \fBfont\fR command for a description of the
+valid formats. If \fBTk_AllocFontFromObj\fR is unsuccessful (because,
+for example, \fIobjPtr\fR did not contain a valid font specification) then it
+returns \fBNULL\fR and leaves an error message in \fIinterp\fR's result
+if \fIinterp\fR isn't NULL. \fBTk_AllocFontFromObj\fR caches
+information about the return
+value in \fIobjPtr\fR, which speeds up future calls to procedures
+such as \fBTk_AllocFontFromObj\fR and \fBTk_GetFontFromObj\fR.
+.PP
+\fBTk_GetFont\fR is identical to \fBTk_AllocFontFromObj\fR except
+that the description of the font is specified with a string instead
+of an object. This prevents \fBTk_GetFont\fR from caching the
+matching Tk_Font, so \fBTk_GetFont\fR is less efficient than
+\fBTk_AllocFontFromObj\fR.
.PP
-\fBTk_GetFont\fR maintains a database of all fonts it has allocated. If
-the same \fIstring\fR is requested multiple times (e.g. by different
-windows or for different purposes), then additional calls for the same
-\fIstring\fR will be handled without involving the platform-specific
-graphics server.
+\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, the return value is the \fIstring\fR argument that was
+\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
-When a font returned by \fBTk_GetFont\fR is no longer needed,
-\fBTk_FreeFont\fR should be called to release it. There should be
-exactly one call to \fBTk_FreeFont\fR for each call to \fBTk_GetFont\fR.
-When a font is no longer in use anywhere (i.e. it has been freed as many
-times as it has been gotten) \fBTk_FreeFont\fR will release any
-platform-specific storage and delete it from the database.
+.VS 8.1
+When a font is no longer needed,
+\fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR should be called to
+release it. For \fBTk_FreeFontFromObj\fR the font to release is specified
+with the same information used to create it; for
+\fBTk_FreeFont\fR the font to release is specified
+with its Tk_Font token. There should be
+exactly one call to \fBTk_FreeFontFromObj\fR or \fBTk_FreeFont\fR
+for each call to \fBTk_AllocFontFromObj\fR or \fBTk_GetFont\fR.
+.VE
.SH KEYWORDS
font
+
diff --git a/tk/doc/GetFontStr.3 b/tk/doc/GetFontStr.3
new file mode 100644
index 00000000000..32783533346
--- /dev/null
+++ b/tk/doc/GetFontStr.3
@@ -0,0 +1,79 @@
+'\"
+'\" Copyright (c) 1990-1992 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) GetFontStr.3 1.10 96/03/26 18:10:03
+'\"
+.so man.macros
+.TH Tk_GetFontStruct 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetFontStruct, Tk_NameOfFontStruct, Tk_FreeFontStruct \- maintain database of fonts
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+XFontStruct *
+\fBTk_GetFontStruct(\fIinterp, tkwin, nameId\fB)\fR
+.sp
+char *
+\fBTk_NameOfFontStruct(\fIfontStructPtr\fB)\fR
+.sp
+\fBTk_FreeFontStruct(\fIfontStructPtr\fB)\fR
+.SH ARGUMENTS
+.AS "XFontStruct" *fontStructPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Token for window in which font will be used.
+.AP Tk_Uid nameId in
+Name of desired font.
+.AP XFontStruct *fontStructPtr in
+Font structure to return name for or delete.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetFont\fR loads the font indicated
+by \fInameId\fR and returns a pointer to information about the
+font. The pointer returned by \fBTk_GetFont\fR
+will remain valid until \fBTk_FreeFont\fR
+is called to release it.
+\fINameId\fR can be either a font name or pattern; any
+value that could be passed to \fBXLoadQueryFont\fR may be
+passed to \fBTk_GetFont\fR. If \fBTk_GetFont\fR is unsuccessful
+(because, for example, there is no font corresponding to
+\fInameId\fR) then it returns \fBNULL\fR and stores an error
+message in \fIinterp->result\fR.
+.PP
+\fBTk_GetFont\fR maintains a database of all fonts it has allocated.
+If the same \fInameId\fR is requested multiple times (e.g. by
+different windows or for different purposes), then additional
+calls for the same \fInameId\fR will be handled very quickly, without
+involving the X server. For this reason, it is generally better
+to use \fBTk_GetFont\fR in place of X library procedures like
+\fBXLoadQueryFont\fR.
+.PP
+The procedure \fBTk_NameOfFontStruct\fR is roughly the inverse of
+\fBTk_GetFontStruct\fR. If its \fIfontStructPtr\fR argument was created
+by \fBTk_GetFontStruct\fR, then the return value is the \fInameId\fR
+argument that was passed to \fBTk_GetFontStruct\fR to create the
+font. If \fIfontStructPtr\fR was not created by a call
+to \fBTk_GetFontStruct\fR, then the return value is a hexadecimal string
+giving the X identifier for the associated font.
+Note: the string returned by \fBTk_NameOfFontStruct\fR is
+only guaranteed to persist until the next call to \fBTk_NameOfFontStruct\fR.
+.PP
+When a font returned by \fBTk_GetFont\fR is no longer
+needed, \fBTk_FreeFont\fR should be called to release it.
+There should be exactly one call to \fBTk_FreeFont\fR for
+each call to \fBTk_GetFont\fR. When a font is no longer in
+use anywhere (i.e. it has been freed as many times as it has been gotten)
+\fBTk_FreeFont\fR will release it to the X server and delete it from
+the database.
+
+.SH KEYWORDS
+font
diff --git a/tk/doc/GetGC.3 b/tk/doc/GetGC.3
index 53e120663c7..4bc7f911a14 100644
--- a/tk/doc/GetGC.3
+++ b/tk/doc/GetGC.3
@@ -72,3 +72,4 @@ will release it to the X server and delete it from the database.
.SH KEYWORDS
graphics context
+
diff --git a/tk/doc/GetHINSTANCE.3 b/tk/doc/GetHINSTANCE.3
new file mode 100644
index 00000000000..587ce151c0a
--- /dev/null
+++ b/tk/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/tk/doc/GetHWND.3 b/tk/doc/GetHWND.3
new file mode 100644
index 00000000000..fb1684c0689
--- /dev/null
+++ b/tk/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 <tk.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/tk/doc/GetImage.3 b/tk/doc/GetImage.3
index 9af712cec2c..de795c49ea0 100644
--- a/tk/doc/GetImage.3
+++ b/tk/doc/GetImage.3
@@ -79,7 +79,7 @@ If the image doesn't exist then \fBTk_GetImage\fR returns NULL
and leaves an error message in \fIinterp->result\fR.
.PP
When a widget wishes to actually display an image it must
-call \fBTk_RedrawWidget\fR, identifying the image (\fIimage\fR),
+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).
@@ -133,3 +133,4 @@ Tk_CreateImageType
.SH KEYWORDS
images, redisplay
+
diff --git a/tk/doc/GetJoinStl.3 b/tk/doc/GetJoinStl.3
index 4d02d6f7b80..6cd457ad006 100644
--- a/tk/doc/GetJoinStl.3
+++ b/tk/doc/GetJoinStl.3
@@ -60,3 +60,4 @@ If \fIjoin\fR isn't a legal join style, then
.SH KEYWORDS
bevel, join style, miter, round
+
diff --git a/tk/doc/GetJustify.3 b/tk/doc/GetJustify.3
index a119075f10c..b6416ff9f65 100644
--- a/tk/doc/GetJustify.3
+++ b/tk/doc/GetJustify.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,15 +8,19 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetJustify 3 4.0 Tk "Tk Library Procedures"
+.TH Tk_GetJustifyFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles
+Tk_GetJustifyFromObj, Tk_GetJustify, Tk_NameOfJustify \- translate between strings and justification styles
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
.sp
-Tk_Justify
+.VS 8.1
+int
+\fBTk_GetJustifyFromObj(\fIinterp, objPtr, justifyPtr\fB)\fR
+.sp
+int
\fBTk_GetJustify(\fIinterp, string, justifyPtr\fB)\fR
.sp
char *
@@ -24,21 +28,30 @@ char *
.SH ARGUMENTS
.AS "Tk_Justify" *justifyPtr
.AP Tcl_Interp *interp in
-Interpreter to use for error reporting.
+Interpreter to use for error reporting, or NULL.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value contains name of justification style (\fBleft\fR, \fBright\fR, or
+\fBcenter\fR). The
+internal rep will be modified to cache corresponding justify value.
.AP char *string in
-String containing name of justification style (``left'', ``right'', or
-``center'').
+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
-\fIstring\fR.
+\fIobjPtr\fR or \fIstring\fR.
.AP Tk_Justify justify in
Justification style (one of the values listed below).
.BE
.SH DESCRIPTION
.PP
-\fBTk_GetJustify\fR places in \fI*justifyPtr\fR the justify value
-corresponding to \fIstring\fR. This value will be one of the following:
+.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
@@ -52,12 +65,23 @@ the line; as a result, the left edges of lines may be ragged.
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 \fIstring\fR doesn't contain a valid justification style
-or an abbreviation of one of these names, then an error message is
-stored in \fIinterp->result\fR, \fBTCL_ERROR\fR is returned, and
-\fI*justifyPtr\fR is unmodified.
+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
@@ -67,3 +91,4 @@ If \fIjustify\fR isn't a legal justify value, then
.SH KEYWORDS
center, fill, justification, string
+
diff --git a/tk/doc/GetOption.3 b/tk/doc/GetOption.3
index 1838ed4fae5..5d848c8630b 100644
--- a/tk/doc/GetOption.3
+++ b/tk/doc/GetOption.3
@@ -44,3 +44,4 @@ quickly than successive calls for different windows.
.SH KEYWORDS
class, name, option, retrieve
+
diff --git a/tk/doc/GetPixels.3 b/tk/doc/GetPixels.3
index b4f3d389448..bb32539f8e4 100644
--- a/tk/doc/GetPixels.3
+++ b/tk/doc/GetPixels.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,17 +8,27 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetPixels 3 "" Tk "Tk Library Procedures"
+.TH Tk_GetPixelsFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetPixels, Tk_GetScreenMM \- translate between strings and screen units
+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
@@ -27,9 +37,15 @@ int
Interpreter to use for error reporting.
.AP Tk_Window tkwin in
Window whose screen geometry determines the conversion between absolute
-units and pixels.
+units and pixels.
+.VS 8.1 br
+.AP Tcl_Obj *objPtr in/out
+String value specifies a distance on the screen;
+internal rep will be modified to cache converted distance.
.AP char *string in
-String that specifies a distance on the screen.
+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
@@ -38,10 +54,16 @@ Pointer to location in which to store converted distance in millimeters.
.SH DESCRIPTION
.PP
-These two procedures take as argument a specification of distance on
-the screen (\fIstring\fR) and compute the corresponding distance
-either in integer pixels or floating-point millimeters.
-In either case, \fIstring\fR specifies a screen distance as a
+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
@@ -61,16 +83,30 @@ The number specifies a distance in millimeters on the screen.
The number specifies a distance in printer's points (1/72 inch)
on the screen.
.PP
-\fBTk_GetPixels\fR converts \fIstring\fR to the nearest even
-number of pixels and stores that value at \fI*intPtr\fR.
-\fBTk_GetScreenMM\fR converts \fIstring\fR to millimeters and
-stores the double-precision floating-point result at \fI*doublePtr\fR.
-.PP
-Both procedures return \fBTCL_OK\fR under normal circumstances.
-If an error occurs (e.g. \fIstring\fR contains a number followed
+.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->result\fR.
+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/tk/doc/GetPixmap.3 b/tk/doc/GetPixmap.3
index 777ba33e482..c96624f0276 100644
--- a/tk/doc/GetPixmap.3
+++ b/tk/doc/GetPixmap.3
@@ -54,3 +54,4 @@ its resource identifier available for reuse.
.SH KEYWORDS
pixmap, resource identifier
+
diff --git a/tk/doc/GetRelief.3 b/tk/doc/GetRelief.3
index cfcde3737cb..4d80fe6fc66 100644
--- a/tk/doc/GetRelief.3
+++ b/tk/doc/GetRelief.3
@@ -1,6 +1,6 @@
'\"
'\" Copyright (c) 1990 The Regents of the University of California.
-'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" 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.
@@ -8,14 +8,19 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetRelief 3 "" Tk "Tk Library Procedures"
+.TH Tk_GetReliefFromObj 3 8.1 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetRelief, Tk_NameOfRelief \- translate between strings and relief values
+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
@@ -25,12 +30,18 @@ char *
.AS "Tcl_Interp" *reliefPtr
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
-.AP char *name in
-String containing relief name (one of ``flat'', ``groove'',
-``raised'', ``ridge'', ``solid'', or ``sunken'').
+.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
-\fIname\fR.
+\fIobjPtr\fR or \fIname\fR.
.AP int relief in
Relief value (one of TK_RELIEF_FLAT, TK_RELIEF_RAISED, TK_RELIEF_SUNKEN,
TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE).
@@ -38,22 +49,34 @@ TK_RELIEF_GROOVE, TK_RELIEF_SOLID, or TK_RELIEF_RIDGE).
.SH DESCRIPTION
.PP
-\fBTk_GetRelief\fR places in \fI*reliefPtr\fR the relief value
-corresponding to \fIname\fR. This value will be one of
+.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 \fIname\fR doesn't contain one of the valid relief names
-or an abbreviation of one of them, then an error message
-is stored in \fIinterp->result\fR,
-TCL_ERROR is returned, and \fI*reliefPtr\fR is unmodified.
+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 (``flat'',
-``raised'', ``sunken'', ``groove'', ``solid'', or ``ridge'').
+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/tk/doc/GetRootCrd.3 b/tk/doc/GetRootCrd.3
index 9726a382b54..283433a0dae 100644
--- a/tk/doc/GetRootCrd.3
+++ b/tk/doc/GetRootCrd.3
@@ -41,3 +41,4 @@ communicate with the X server.
.SH KEYWORDS
coordinates, root window
+
diff --git a/tk/doc/GetScroll.3 b/tk/doc/GetScroll.3
index 0a8a0e4dcbc..576f1905d52 100644
--- a/tk/doc/GetScroll.3
+++ b/tk/doc/GetScroll.3
@@ -8,16 +8,19 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_GetScrollInfo 3 4.0 Tk "Tk Library Procedures"
+.TH Tk_GetScrollInfo 3 8.0 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_GetScrollInfo \- parse arguments for scrolling commands
+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
@@ -27,8 +30,13 @@ Number of strings in \fIargv\fR array.
.AP char *argv[] in
Argument strings. These represent the entire widget command, of
which the first word is typically the widget name and the second
-word is typically \fBxview\fR or \fByview\fR. This procedure parses
-arguments starting with \fIargv\fR[2].
+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
@@ -60,6 +68,13 @@ 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/tk/doc/GetSelect.3 b/tk/doc/GetSelect.3
index 92c03eb6f19..d4a0ce0d646 100644
--- a/tk/doc/GetSelect.3
+++ b/tk/doc/GetSelect.3
@@ -77,3 +77,4 @@ and return TCL_ERROR; this will abort the selection retrieval.
.SH KEYWORDS
format, get, selection retrieval
+
diff --git a/tk/doc/GetUid.3 b/tk/doc/GetUid.3
index 77e896771dc..433a1fad1a0 100644
--- a/tk/doc/GetUid.3
+++ b/tk/doc/GetUid.3
@@ -48,3 +48,4 @@ same string value as its argument (strcmp(Tk_GetUid(a), a) == 0).
.SH KEYWORDS
atom, unique identifier
+
diff --git a/tk/doc/GetVRoot.3 b/tk/doc/GetVRoot.3
index 9cf7d1bd0f3..cc7bc918836 100644
--- a/tk/doc/GetVRoot.3
+++ b/tk/doc/GetVRoot.3
@@ -47,3 +47,4 @@ will be set to the dimensions of the screen containing \fItkwin\fR.
.SH KEYWORDS
geometry, height, location, virtual root, width, window manager
+
diff --git a/tk/doc/GetVisual.3 b/tk/doc/GetVisual.3
index c8a0f2c5e22..b210abc50b3 100644
--- a/tk/doc/GetVisual.3
+++ b/tk/doc/GetVisual.3
@@ -96,3 +96,4 @@ from Paul Mackerras.
.SH KEYWORDS
colormap, screen, visual
+
diff --git a/tk/doc/Grab.3 b/tk/doc/Grab.3
new file mode 100644
index 00000000000..d9ea162be7d
--- /dev/null
+++ b/tk/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/tk/doc/HWNDToWindow.3 b/tk/doc/HWNDToWindow.3
new file mode 100644
index 00000000000..05367bf4f8c
--- /dev/null
+++ b/tk/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 <tk.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/tk/doc/HandleEvent.3 b/tk/doc/HandleEvent.3
index d139eeaf0a5..1d8de4395d3 100644
--- a/tk/doc/HandleEvent.3
+++ b/tk/doc/HandleEvent.3
@@ -26,15 +26,15 @@ Pointer to X event to dispatch to relevant handler(s).
.SH DESCRIPTION
.PP
\fBTk_HandleEvent\fR is a lower-level procedure that deals with window
-events. It is called by \fBTk_ServiceEvent\fR (and indirectly by
+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 \fBTk_QueueEvent\fR followed by
-\fBTk_ServiceEvent\fR.
+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
@@ -47,3 +47,4 @@ doing anything else.
.SH KEYWORDS
callback, event, handler, window
+
diff --git a/tk/doc/IdToWindow.3 b/tk/doc/IdToWindow.3
index 0755f35bbb9..e8235b35926 100644
--- a/tk/doc/IdToWindow.3
+++ b/tk/doc/IdToWindow.3
@@ -34,3 +34,4 @@ NULL is returned.
.SH KEYWORDS
X window id
+
diff --git a/tk/doc/ImgChanged.3 b/tk/doc/ImgChanged.3
index 7588fb8cc4d..fa2093f8e89 100644
--- a/tk/doc/ImgChanged.3
+++ b/tk/doc/ImgChanged.3
@@ -67,3 +67,4 @@ Tk_CreateImageType
.SH KEYWORDS
images, redisplay, image size changes
+
diff --git a/tk/doc/InternAtom.3 b/tk/doc/InternAtom.3
index 0806415cafc..d4b0f2fbcbd 100644
--- a/tk/doc/InternAtom.3
+++ b/tk/doc/InternAtom.3
@@ -56,3 +56,4 @@ should be used in place of the Xlib procedures.
.SH KEYWORDS
atom, cache, display
+
diff --git a/tk/doc/MainLoop.3 b/tk/doc/MainLoop.3
index 2cbe3c9d06b..e1947e621bb 100644
--- a/tk/doc/MainLoop.3
+++ b/tk/doc/MainLoop.3
@@ -30,3 +30,4 @@ entirely of callbacks invoked via \fBTcl_DoOneEvent\fR.
.SH KEYWORDS
application, event, main loop
+
diff --git a/tk/doc/MainWin.3 b/tk/doc/MainWin.3
index 914a13a8f2c..81f2144c163 100644
--- a/tk/doc/MainWin.3
+++ b/tk/doc/MainWin.3
@@ -11,13 +11,18 @@
.TH Tk_MainWindow 3 7.0 Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_MainWindow \- find the main window for an application
+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
@@ -26,11 +31,18 @@ Interpreter associated with the application.
.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.
+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/tk/doc/MaintGeom.3 b/tk/doc/MaintGeom.3
index df1b5e5047b..20a8cf84d79 100644
--- a/tk/doc/MaintGeom.3
+++ b/tk/doc/MaintGeom.3
@@ -100,3 +100,4 @@ pair that is isn't currently managed, the call has no effect.
.SH KEYWORDS
geometry manager, map, master, parent, position, slave, unmap
+
diff --git a/tk/doc/ManageGeom.3 b/tk/doc/ManageGeom.3
index 50e0c7aa682..e72249cd4c2 100644
--- a/tk/doc/ManageGeom.3
+++ b/tk/doc/ManageGeom.3
@@ -92,3 +92,4 @@ corresponding parameters passed to \fBTk_ManageGeometry\fR.
.SH KEYWORDS
callback, geometry, managed, request, unmanaged
+
diff --git a/tk/doc/MapWindow.3 b/tk/doc/MapWindow.3
index 452fb6eab44..4f8a550262a 100644
--- a/tk/doc/MapWindow.3
+++ b/tk/doc/MapWindow.3
@@ -37,11 +37,11 @@ deferred window creation.
\fBTk_UnmapWindow\fR unmaps \fItkwin\fR's window
from the screen.
.PP
-If \fItkwin\fR is a child window (i.e. \fBTk_CreateChildWindow\fR was
-used to create it), then event handlers interested in map and unmap events
-are invoked immediately. If \fItkwin\fR isn't an internal window,
-then the event handlers will be invoked later, after X has seen
-the request and returned an event for it.
+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
@@ -51,3 +51,4 @@ directly.
.SH KEYWORDS
map, unmap, window
+
diff --git a/tk/doc/MeasureChar.3 b/tk/doc/MeasureChar.3
index 86424e61c2d..57ba4b1fa9c 100644
--- a/tk/doc/MeasureChar.3
+++ b/tk/doc/MeasureChar.3
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_MeasureChars 3 "" Tk "Tk Library Procedures"
+.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.
@@ -16,16 +16,16 @@ Tk_MeasureChars, Tk_TextWidth, Tk_DrawChars, Tk_UnderlineChars \- routines to me
\fB#include <tk.h>\fR
.sp
int
-\fBTk_MeasureChars(\fItkfont, string, maxChars, maxPixels, flags, lengthPtr\fB)\fR
+\fBTk_MeasureChars(\fItkfont, string, numBytes, maxPixels, flags, lengthPtr\fB)\fR
.sp
int
-\fBTk_TextWidth(\fItkfont, string, numChars\fB)\fR
+\fBTk_TextWidth(\fItkfont, string, numBytes\fB)\fR
.sp
void
-\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numChars, x, y\fB)\fR
+\fBTk_DrawChars(\fIdisplay, drawable, gc, tkfont, string, numBytes, x, y\fB)\fR
.sp
void
-\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstChar, lastChar\fB)\fR
+\fBTk_UnderlineChars(\fIdisplay, drawable, gc, tkfont, string, x, y, firstByte, lastByte\fB)\fR
.sp
.SH ARGUMENTS
.AS "const char" firstChar
@@ -37,13 +37,15 @@ Text to be measured or displayed. Need not be null terminated. Any
non-printing meta-characters in the string (such as tabs, newlines, and
other control characters) will be measured or displayed in a
platform-dependent manner.
-.AP int maxChars in
-The maximum number of characters to consider when measuring \fIstring\fR.
-Must be greater than or equal to 0.
+.VS 8.1
+.AP int numBytes in
+The maximum number of bytes to consider when measuring or drawing
+\fIstring\fR. Must be greater than or equal to 0.
+.VE 8.1
.AP int maxPixels in
-If \fImaxPixels\fR is greater than 0, it specifies the longest permissible
+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
+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
@@ -59,9 +61,6 @@ letter will still be returned.
.AP int *lengthPtr out
Filled with the number of pixels occupied by the number of characters
returned as the result of \fBTk_MeasureChars\fR.
-.AP int numChars in
-The total number of characters to measure or draw from \fIstring\fR. Must
-be greater than or equal to 0.
.AP Display *display in
Display on which to draw.
.AP Drawable drawable in
@@ -72,13 +71,15 @@ must be the same as the \fItkfont\fR.
.AP int "x, y" in
Coordinates at which to place the left edge of the baseline when displaying
\fIstring\fR.
-.AP int firstChar in
-The index of the first character to underline in the \fIstring\fR.
-Underlining begins at the left edge of this character.
-.AP int lastChar in
-The index of the last character up to which the underline will
-be drawn. The character specified by \fIlastChar\fR will not itself be
-underlined.
+.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
@@ -88,7 +89,13 @@ 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.
+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.
@@ -103,10 +110,10 @@ newlines/returns into multi-line text.
.PP
\fBTk_MeasureChars\fR is used both to compute the length of a given
string and to compute how many characters from a string fit in a given
-amount of space. The return value is the number of characters from
+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 \fImaxChars\fR. \fI*lengthPtr\fR is filled with the computed
+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
@@ -128,3 +135,4 @@ text, the appropriate underlined font should be constructed and used.
.SH KEYWORDS
font
+
diff --git a/tk/doc/MoveToplev.3 b/tk/doc/MoveToplev.3
index b0b076f4ada..915a70c9283 100644
--- a/tk/doc/MoveToplev.3
+++ b/tk/doc/MoveToplev.3
@@ -53,3 +53,4 @@ using the \fBTk_DoWhenIdle\fR mechanism.
.SH KEYWORDS
position, top-level window, window manager
+
diff --git a/tk/doc/Name.3 b/tk/doc/Name.3
index 3aa86b637ae..867745b33b5 100644
--- a/tk/doc/Name.3
+++ b/tk/doc/Name.3
@@ -80,3 +80,4 @@ need not be the case: any window in the desired hierarchy may be used.
.SH KEYWORDS
name, path name, token, window
+
diff --git a/tk/doc/NameOfImg.3 b/tk/doc/NameOfImg.3
index 94b5f4b3428..2b2edb7b8f9 100644
--- a/tk/doc/NameOfImg.3
+++ b/tk/doc/NameOfImg.3
@@ -32,3 +32,4 @@ string name for the image.
.SH KEYWORDS
image manager, image name
+
diff --git a/tk/doc/Notifier.3 b/tk/doc/Notifier.3
new file mode 100644
index 00000000000..5016200ab62
--- /dev/null
+++ b/tk/doc/Notifier.3
@@ -0,0 +1,537 @@
+'\"
+'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) Notifier.3 1.16 97/05/17 17:03:17
+'\"
+.so man.macros
+.TH Notifier 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.VS
+.SH NAME
+Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_DeleteEvents, Tcl_WaitForEvent, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces
+
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+.sp
+\fBTcl_DeleteEventSource\fR(\fIsetupProc, checkProc, clientData\fB)\fR
+.sp
+\fBTcl_SetMaxBlockTime\fR(\fItimePtr\fB)\fR
+.sp
+\fBTcl_QueueEvent\fR(\fIevPtr, position\fR)
+.VS
+.sp
+\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
+.sp
+int
+\fBTcl_WaitForEvent\fR(\fItimePtr\fR)
+.sp
+\fBTcl_SetTimer\fR(\fItimePtr\fR)
+.sp
+int
+\fBTcl_ServiceAll\fR()
+.sp
+int
+\fBTcl_ServiceEvent\fR(\fIflags\fR)
+.sp
+int
+\fBTcl_GetServiceMode\fR()
+.sp
+int
+\fBTcl_SetServiceMode\fR(\fImode\fR)
+.VE
+
+.SH ARGUMENTS
+.AS Tcl_EventDeleteProc milliseconds
+.AS Tcl_EventSetupProc *setupProc
+.AP Tcl_EventSetupProc *setupProc in
+Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
+.AP Tcl_EventCheckProc *checkProc in
+Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for
+events. Checks to see if any events have occurred and, if so,
+queues them.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
+\fIdeleteProc\fR.
+.AP Tcl_Time *timePtr in
+Indicates the maximum amount of time to wait for an event. This
+is specified as an interval (how long to wait), not an absolute
+time (when to wakeup). If the pointer passed to \fBTcl_WaitForEvent\fR
+is NULL, it means there is no maximum wait time: wait forever if
+necessary.
+.AP Tcl_Event *evPtr in
+An event to add to the event queue. The storage for the event must
+have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
+.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.
+.AP int flags in
+What types of events to service. These flags are the same as those
+passed to \fBTcl_DoOneEvent\fR.
+.AP Tcl_EventDeleteProc *deleteProc in
+Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
+.VS
+.AP int mode in
+Inidicates whether events should be serviced by \fBTcl_ServiceAll\fR.
+Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
+.VE
+.BE
+
+.SH INTRODUCTION
+.PP
+.VS
+The interfaces described here are used to customize the Tcl event
+loop. The two most common customizations are to add new sources of
+events and to merge Tcl's event loop with some other event loop, such
+as one provided by an application in which Tcl is embedded. Each of
+these tasks is described in a separate section below.
+.VE
+.PP
+The procedures in this manual entry are the building blocks out of which
+the Tcl event notifier is constructed. The event notifier is the lowest
+layer in the Tcl event mechanism. It consists of three things:
+.IP [1]
+Event sources: these represent the ways in which events can be
+generated. For example, there is a timer event source that implements
+the \fBTcl_CreateTimerHandler\fR procedure and the \fBafter\fR
+command, and there is a file event source that implements the
+\fBTcl_CreateFileHandler\fR procedure on Unix systems. An event
+source must work with the notifier to detect events at the right
+times, record them on the event queue, and eventually notify
+higher-level software that they have occurred. The procedures
+\fBTcl_CreateEventSource\fR, \fBTcl_DeleteEventSource\fR,
+and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and
+\fBTcl_DeleteEvents\fR are used primarily by event sources.
+.IP [2]
+The event queue: there is a single queue for the whole application,
+containing events that have been detected but not yet serviced. Event
+sources place events onto the queue so that they may be processed in
+order at appropriate times during the event loop. The event queue
+guarantees a fair discipline of event handling, so that no event
+source can starve the others. It also allows events to be saved for
+servicing at a future time.
+.VS
+\fBTcl_QueueEvent\fR is used (primarily
+by event sources) to add events to the event queue and
+\fBTcl_DeleteEvents\fR is used to remove events from the queue without
+processing them.
+.IP [3]
+The event loop: in order to detect and process events, the application
+enters a loop that waits for events to occur, places them on the event
+queue, and then processes them. Most applications will do this by
+calling the procedure \fBTcl_DoOneEvent\fR, which is described in a
+separate manual entry.
+.PP
+Most Tcl applications need not worry about any of the internals of
+the Tcl notifier. However, the notifier now has enough flexibility
+to be retargeted either for a new platform or to use an external event
+loop (such as the Motif event loop, when Tcl is embedded in a Motif
+application). The procedures \fBTcl_WaitForEvent\fR and
+\fBTcl_SetTimer\fR are normally implemented by Tcl, but may be
+replaced with new versions to retarget the notifier (the \fBTcl_Sleep\fR,
+\fBTcl_CreateFileHandler\fR, and \fBTcl_DeleteFileHandler\fR must
+also be replaced; see CREATING A NEW NOTIFIER below for details).
+The procedures \fBTcl_ServiceAll\fR, \fBTcl_ServiceEvent\fR,
+\fBTcl_GetServiceMode\fR, and \fBTcl_SetServiceMode\fR are provided
+to help connect Tcl's event loop to an external event loop such as
+Motif's.
+.SH "NOTIFIER BASICS"
+.VE
+.PP
+The easiest way to understand how the notifier works is to consider
+what happens when \fBTcl_DoOneEvent\fR is called.
+\fBTcl_DoOneEvent\fR is passed a \fIflags\fR argument that indicates
+what sort of events it is OK to process and also whether or not to
+block if no events are ready. \fBTcl_DoOneEvent\fR does the following
+things:
+.IP [1]
+Check the event queue to see if it contains any events that can
+be serviced. If so, service the first possible event, remove it
+.VS
+from the queue, and return. It does this by calling
+\fBTcl_ServiceEvent\fR and passing in the \fIflags\fR argument.
+.VE
+.IP [2]
+Prepare to block for an event. To do this, \fBTcl_DoOneEvent\fR
+invokes a \fIsetup procedure\fR in each event source.
+The event source will perform event-source specific initialization and
+.VS
+possibly call \fBTcl_SetMaxBlockTime\fR to limit how long
+.VE
+\fBTcl_WaitForEvent\fR will block if no new events occur.
+.IP [3]
+Call \fBTcl_WaitForEvent\fR. This procedure is implemented differently
+on different platforms; it waits for an event to occur, based on the
+information provided by the event sources.
+It may cause the application to block if \fItimePtr\fR specifies
+an interval other than 0.
+\fBTcl_WaitForEvent\fR returns when something has happened,
+such as a file becoming readable or the interval given by \fItimePtr\fR
+expiring. If there are no events for \fBTcl_WaitForEvent\fR to
+wait for, so that it would block forever, then it returns immediately
+and \fBTcl_DoOneEvent\fR returns 0.
+.IP [4]
+Call a \fIcheck procedure\fR in each event source. The check
+procedure determines whether any events of interest to this source
+occurred. If so, the events are added to the event queue.
+.IP [5]
+Check the event queue to see if it contains any events that can
+be serviced. If so, service the first possible event, remove it
+from the queue, and return.
+.IP [6]
+See if there are idle callbacks pending. If so, invoke all of them and
+return.
+.IP [7]
+Either return 0 to indicate that no events were ready, or go back to
+step [2] if blocking was requested by the caller.
+
+.SH "CREATING A NEW EVENT SOURCE"
+.PP
+An event source consists of three procedures invoked by the notifier,
+plus additional C procedures that are invoked by higher-level code
+to arrange for event-driven callbacks. The three procedures called
+by the notifier consist of the setup and check procedures described
+above, plus an additional procedure that is invoked when an event
+is removed from the event queue for servicing.
+.PP
+The procedure \fBTcl_CreateEventSource\fR creates a new event source.
+Its arguments specify the setup procedure and check procedure for
+the event source.
+\fISetupProc\fR should match the following prototype:
+.CS
+typedef void Tcl_EventSetupProc(
+ ClientData \fIclientData\fR,
+ int \fIflags\fR);
+.CE
+The \fIclientData\fR argument will be the same as the \fIclientData\fR
+argument to \fBTcl_CreateEventSource\fR; it is typically used to
+point to private information managed by the event source.
+The \fIflags\fR argument will be the same as the \fIflags\fR
+argument passed to \fBTcl_DoOneEvent\fR except that it will never
+be 0 (\fBTcl_DoOneEvent\fR replaces 0 with \fBTCL_ALL_EVENTS\fR).
+\fIFlags\fR indicates what kinds of events should be considered;
+if the bit corresponding to this event source isn't set, the event
+source should return immediately without doing anything. For
+example, the file event source checks for the \fBTCL_FILE_EVENTS\fR
+bit.
+.PP
+\fISetupProc\fR's job is to make sure that the application wakes up
+when events of the desired type occur. This is typically done in a
+platform-dependent fashion. For example, under Unix an event source
+might call \fBTcl_CreateFileHandler\fR; under Windows it might
+request notification with a Windows event. For timer-driven event
+sources such as timer events or any polled event, the event source
+can call \fBTcl_SetMaxBlockTime\fR to force the application to wake
+up after a specified time even if no events have occurred.
+.VS
+If no event source calls \fBTcl_SetMaxBlockTime\fR
+then \fBTcl_WaitForEvent\fR will wait as long as necessary for an
+event to occur; otherwise, it will only wait as long as the shortest
+interval passed to \fBTcl_SetMaxBlockTime\fR by one of the event
+sources. If an event source knows that it already has events ready to
+report, it can request a zero maximum block time. For example, the
+setup procedure for the X event source looks to see if there are
+events already queued. If there are, it calls
+\fBTcl_SetMaxBlockTime\fR with a 0 block time so that
+\fBTcl_WaitForEvent\fR does not block if there is no new data on the X
+connection.
+.VE
+The \fItimePtr\fR argument to \fBTcl_WaitForEvent\fR points to
+a structure that describes a time interval in seconds and
+microseconds:
+.CS
+typedef struct Tcl_Time {
+ long \fIsec\fR;
+ long \fIusec\fR;
+} Tcl_Time;
+.CE
+The \fIusec\fR field should be less than 1000000.
+.PP
+.VS
+Information provided to \fBTcl_SetMaxBlockTime\fR
+is only used for the next call to \fBTcl_WaitForEvent\fR; it is
+discarded after \fBTcl_WaitForEvent\fR returns.
+.VE
+The next time an event wait is done each of the event sources'
+setup procedures will be called again, and they can specify new
+information for that event wait.
+.PP
+.VS
+If the application uses an external event loop rather than
+\fBTcl_DoOneEvent\fR, the event sources may need to call
+\fBTcl_SetMaxBlockTime\fR at other times. For example, if a new event
+handler is registered that needs to poll for events, the event source
+may call \fBTcl_SetMaxBlockTime\fR to set the block time to zero to
+force the external event loop to call Tcl. In this case,
+\fBTcl_SetMaxBlockTime\fR invokes \fBTcl_SetTimer\fR with the shortest
+interval seen since the last call to \fBTcl_DoOneEvent\fR or
+\fBTcl_ServiceAll\fR.
+.PP
+In addition to the generic procedure \fBTcl_SetMaxBlockTime\fR, other
+platform-specific procedures may also be available for
+\fIsetupProc\fR, if there is additional information needed by
+\fBTcl_WaitForEvent\fR on that platform. For example, on Unix systems
+the \fBTcl_CreateFileHandler\fR interface can be used to wait for file events.
+.VE
+.PP
+The second procedure provided by each event source is its check
+procedure, indicated by the \fIcheckProc\fR argument to
+\fBTcl_CreateEventSource\fR. \fICheckProc\fR must match the
+following prototype:
+.CS
+typedef void Tcl_EventCheckProc(
+ ClientData \fIclientData\fR,
+ int \fIflags\fR);
+.CE
+The arguments to this procedure are the same as those for \fIsetupProc\fR.
+\fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited
+for events. Presumably at least one event source is now prepared to
+queue an event. \fBTcl_DoOneEvent\fR calls each of the event sources
+in turn, so they all have a chance to queue any events that are ready.
+The check procedure does two things. First, it must see if any events
+have triggered. Different event sources do this in different ways.
+.PP
+If an event source's check procedure detects an interesting event, it
+must add the event to Tcl's event queue. To do this, the event source
+calls \fBTcl_QueueEvent\fR. The \fIevPtr\fR argument is a pointer to
+a dynamically allocated structure containing the event (see below for
+more information on memory management issues). Each event source can
+define its own event structure with whatever information is relevant
+to that event source. However, the first element of the structure
+must be a structure of type \fBTcl_Event\fR, and the address of this
+structure is used when communicating between the event source and the
+rest of the notifier. A \fBTcl_Event\fR has the following definition:
+.CS
+typedef struct Tcl_Event {
+ Tcl_EventProc *\fIproc\fR;
+ struct Tcl_Event *\fInextPtr\fR;
+};
+.CE
+The event source must fill in the \fIproc\fR field of
+the event before calling \fBTcl_QueueEvent\fR.
+The \fInextPtr\fR is used to link together the events in the queue
+and should not be modified by the event source.
+.PP
+An event may be added to the queue at any of three positions, depending
+on the \fIposition\fR argument to \fBTcl_QueueEvent\fR:
+.IP \fBTCL_QUEUE_TAIL\fR 24
+Add the event at the back of the queue, so that all other pending
+events will be serviced first. This is almost always the right
+place for new events.
+.IP \fBTCL_QUEUE_HEAD\fR 24
+Add the event at the front of the queue, so that it will be serviced
+before all other queued events.
+.IP \fBTCL_QUEUE_MARK\fR 24
+Add the event at the front of the queue, unless there are other
+events at the front whose position is \fBTCL_QUEUE_MARK\fR; if so,
+add the new event just after all other \fBTCL_QUEUE_MARK\fR events.
+This value of \fIposition\fR is used to insert an ordered sequence of
+events at the front of the queue, such as a series of
+Enter and Leave events synthesized during a grab or ungrab operation
+in Tk.
+.PP
+.VS
+When it is time to handle an event from the queue (steps 1 and 4
+above) \fBTcl_ServiceEvent\fR will invoke the \fIproc\fR specified
+.VE
+in the first queued \fBTcl_Event\fR structure.
+\fIProc\fR must match the following prototype:
+.CS
+typedef int Tcl_EventProc(
+ Tcl_Event *\fIevPtr\fR,
+ int \fIflags\fR);
+.CE
+The first argument to \fIproc\fR is a pointer to the event, which will
+be the same as the first argument to the \fBTcl_QueueEvent\fR call that
+added the event to the queue.
+The second argument to \fIproc\fR is the \fIflags\fR argument for the
+.VS
+current call to \fBTcl_ServiceEvent\fR; this is used by the event source
+.VE
+to return immediately if its events are not relevant.
+.PP
+It is up to \fIproc\fR to handle the event, typically by invoking
+one or more Tcl commands or C-level callbacks.
+Once the event source has finished handling the event it returns 1
+to indicate that the event can be removed from the queue.
+If for some reason the event source decides that the event cannot
+be handled at this time, it may return 0 to indicate that the event
+.VS
+should be deferred for processing later; in this case \fBTcl_ServiceEvent\fR
+.VE
+will go on to the next event in the queue and attempt to service it.
+There are several reasons why an event source might defer an event.
+One possibility is that events of this type are excluded by the
+\fIflags\fR argument.
+For example, the file event source will always return 0 if the
+\fBTCL_FILE_EVENTS\fR bit isn't set in \fIflags\fR.
+Another example of deferring events happens in Tk if
+\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
+of window events.
+.PP
+.VS
+When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the
+event from the event queue and free its storage.
+Note that the storage for an event must be allocated by
+the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR)
+before calling \fBTcl_QueueEvent\fR, but it
+will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
+.PP
+\fBTcl_DeleteEvents\fR can be used to explicitly remove one or more
+events from the event queue. \fBTcl_DeleteEvents\fR calls \fIproc\fR
+for each event in the queue, deleting those for with the procedure
+returns 1. Events for which the procedure returns 0 are left in the
+queue. \fIProc\fR should match the following prototype:
+.CS
+typedef int Tcl_EventDeleteProc(
+ Tcl_Event *\fIevPtr\fR,
+ ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR argument will be the same as the \fIclientData\fR
+argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
+private information managed by the event source. The \fIevPtr\fR will
+point to the next event in the queue.
+.VE
+
+.SH "CREATING A NEW NOTIFIER"
+.PP
+The notifier consists of all the procedures described in this manual
+entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR, which are
+.VS
+available on all platforms, and \fBTcl_CreateFileHandler\fR and
+\fBTcl_DeleteFileHandler\fR, which are Unix-specific. Most of these
+procedures are generic, in that they are the same for all notifiers.
+However, five of the procedures are notifier-dependent:
+\fBTcl_SetTimer\fR, \fBTcl_Sleep\fR, \fBTcl_WaitForEvent\fR,
+\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR. To
+support a new platform or to integrate Tcl with an
+application-specific event loop, you must write new versions of these
+procedures.
+.PP
+\fBTcl_WaitForEvent\fR is the lowest-level procedure in the notifier;
+it is responsible for waiting for an ``interesting'' event to occur or
+for a given time to elapse. Before \fBTcl_WaitForEvent\fR is invoked,
+each of the event sources' setup procedure will have been invoked.
+The \fItimePtr\fR argument to
+\fBTcl_WaitForEvent\fR gives the maximum time to block for an event,
+based on calls to \fBTcl_SetMaxBlockTime\fR made by setup procedures
+and on other information (such as the \fBTCL_DONT_WAIT\fR bit in
+\fIflags\fR).
+.PP
+Ideally, \fBTcl_WaitForEvent\fR should only wait for an event
+to occur; it should not actually process the event in any way.
+Later on, the
+event sources will process the raw events and create Tcl_Events on
+the event queue in their \fIcheckProc\fR procedures.
+However, on some platforms (such as Windows) this isn't possible;
+events may be processed in \fBTcl_WaitForEvent\fR, including queuing
+Tcl_Events and more (for example, callbacks for native widgets may be
+invoked). The return value from \fBTcl_WaitForEvent\fR must be either
+0, 1, or \-1. On platforms such as Windows where events get processed in
+\fBTcl_WaitForEvent\fR, a return value of 1 means that there may be more
+events still pending that haven't been processed. This is a sign to the
+caller that it must call \fBTcl_WaitForEvent\fR again if it wants all
+pending events to be processed. A 0 return value means that calling
+\fBTcl_WaitForEvent\fR again will not have any effect: either this is a
+platform where \fBTcl_WaitForEvent\fR only waits without doing any event
+processing, or \fBTcl_WaitForEvent\fR knows for sure that there are no
+additional events to process (e.g. it returned because the time
+elapsed). Finally, a return value of \-1 means that the event loop is
+no longer operational and the application should probably unwind and
+terminate. Under Windows this happens when a WM_QUIT message is received;
+under Unix it happens when \fBTcl_WaitForEvent\fR would have waited
+forever because there were no active event sources and the timeout was
+infinite.
+.PP
+If the notifier will be used with an external event loop, then it must
+also support the \fBTcl_SetTimer\fR interface. \fBTcl_SetTimer\fR is
+invoked by \fBTcl_SetMaxBlockTime\fR whenever the maximum blocking
+time has been reduced. \fBTcl_SetTimer\fR should arrange for the
+external event loop to invoke \fBTcl_ServiceAll\fR after the specified
+interval even if no events have occurred. This interface is needed
+because \fBTcl_WaitForEvent\fR isn't invoked when there is an external
+event loop. If the
+notifier will only be used from \fBTcl_DoOneEvent\fR, then
+\fBTcl_SetTimer\fR need not do anything.
+.PP
+On Unix systems, the file event source also needs support from the
+notifier. The file event source consists of the
+\fBTcl_CreateFileHandler\fR and \fBTcl_DeleteFileHandler\fR
+procedures, which are described elsewhere.
+.PP
+The \fBTcl_Sleep\fR and \fBTcl_DoOneEvent\fR interfaces are described
+elsewhere.
+.PP
+The easiest way to create a new notifier is to look at the code
+for an existing notifier, such as the files \fBunix/tclUnixNotfy.c\fR
+or \fBwin/tclWinNotify.c\fR in the Tcl source distribution.
+
+.SH "EXTERNAL EVENT LOOPS"
+.PP
+The notifier interfaces are designed so that Tcl can be embedded into
+applications that have their own private event loops. In this case,
+the application does not call \fBTcl_DoOneEvent\fR except in the case
+of recursive event loops such as calls to the Tcl commands \fBupdate\fR
+or \fBvwait\fR. Most of the time is spent in the external event loop
+of the application. In this case the notifier must arrange for the
+external event loop to call back into Tcl when something
+happens on the various Tcl event sources. These callbacks should
+arrange for appropriate Tcl events to be placed on the Tcl event queue.
+.PP
+Because the external event loop is not calling \fBTcl_DoOneEvent\fR on
+a regular basis, it is up to the notifier to arrange for
+\fBTcl_ServiceEvent\fR to be called whenever events are pending on the
+Tcl event queue. The easiest way to do this is to invoke
+\fBTcl_ServiceAll\fR at the end of each callback from the external
+event loop. This will ensure that all of the event sources are
+polled, any queued events are serviced, and any pending idle handlers
+are processed before returning control to the application. In
+addition, event sources that need to poll for events can call
+\fBTcl_SetMaxBlockTime\fR to force the external event loop to call
+Tcl even if no events are available on the system event queue.
+.PP
+As a side effect of processing events detected in the main external
+event loop, Tcl may invoke \fBTcl_DoOneEvent\fR to start a recursive event
+loop in commands like \fBvwait\fR. \fBTcl_DoOneEvent\fR will invoke
+the external event loop, which will result in callbacks as described
+in the preceding paragraph, which will result in calls to
+\fBTcl_ServiceAll\fR. However, in these cases it is undesirable to
+service events in \fBTcl_ServiceAll\fR. Servicing events there is
+unnecessary because control will immediately return to the
+external event loop and hence to \fBTcl_DoOneEvent\fR, which can
+service the events itself. Furthermore, \fBTcl_DoOneEvent\fR is
+supposed to service only a single event, whereas \fBTcl_ServiceAll\fR
+normally services all pending events. To handle this situation,
+\fBTcl_DoOneEvent\fR sets a flag for \fBTcl_ServiceAll\fR
+that causes it to return without servicing any events.
+This flag is called the \fIservice mode\fR;
+\fBTcl_DoOneEvent\fR restores it to its previous value before it returns.
+.PP
+In some cases, however, it may be necessary for \fBTcl_ServiceAll\fR
+to service events
+even when it has been invoked from \fBTcl_DoOneEvent\fR. This happens
+when there is yet another recursive event loop invoked via an
+event handler called by \fBTcl_DoOneEvent\fR (such as one that is
+part of a native widget). In this case, \fBTcl_DoOneEvent\fR may not
+have a chance to service events so \fBTcl_ServiceAll\fR must service
+them all. Any recursive event loop that calls an external event
+loop rather than \fBTcl_DoOneEvent\fR must reset the service mode so
+that all events get processed in \fBTcl_ServiceAll\fR. This is done
+by invoking the \fBTcl_SetServiceMode\fR procedure. If
+\fBTcl_SetServiceMode\fR is passed \fBTCL_SERVICE_NONE\fR, then calls
+to \fBTcl_ServiceAll\fR will return immediately without processing any
+events. If \fBTcl_SetServiceMode\fR is passed \fBTCL_SERVICE_ALL\fR,
+then calls to \fBTcl_ServiceAll\fR will behave normally.
+\fBTcl_SetServiceMode\fR returns the previous value of the service
+mode, which should be restored when the recursive loop exits.
+\fBTcl_GetServiceMode\fR returns the current value of the service
+mode.
+.VE
+
+.SH KEYWORDS
+event, notifier, event queue, event sources, file events, timer, idle, service mode
diff --git a/tk/doc/OwnSelect.3 b/tk/doc/OwnSelect.3
index 9b2e59d1e14..ad300a69acc 100644
--- a/tk/doc/OwnSelect.3
+++ b/tk/doc/OwnSelect.3
@@ -50,3 +50,4 @@ information about \fItkwin\fR.
.SH KEYWORDS
own, selection owner
+
diff --git a/tk/doc/ParseArgv.3 b/tk/doc/ParseArgv.3
index ba271bcad0a..791a8e36726 100644
--- a/tk/doc/ParseArgv.3
+++ b/tk/doc/ParseArgv.3
@@ -349,3 +349,4 @@ and \fIargv\fR[2] will be NULL.
.SH KEYWORDS
arguments, command line, options
+
diff --git a/tk/doc/Preserve.3 b/tk/doc/Preserve.3
new file mode 100644
index 00000000000..a2c7d280634
--- /dev/null
+++ b/tk/doc/Preserve.3
@@ -0,0 +1,103 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) Preserve.3 1.13 96/05/28 09:26:12
+'\"
+.so man.macros
+.TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it's being used
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_Preserve\fR(\fIclientData\fR)
+.sp
+\fBTcl_Release\fR(\fIclientData\fR)
+.sp
+\fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR)
+.SH ARGUMENTS
+.AS Tcl_FreeProc clientData
+.AP ClientData clientData in
+Token describing structure to be freed or reallocated. Usually a pointer
+to memory for structure.
+.AP Tcl_FreeProc *freeProc in
+Procedure to invoke to free \fIclientData\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These three procedures help implement a simple reference count mechanism
+for managing storage. They are designed to solve a problem
+having to do with widget deletion, but are also useful in many other
+situations. When a widget is deleted, its
+widget record (the structure holding information specific to the
+widget) must be returned to the storage allocator.
+However, it's possible that the widget record is in active use
+by one of the procedures on the stack at the time of the deletion.
+This can happen, for example, if the command associated with a button
+widget causes the button to be destroyed: an X event causes an
+event-handling C procedure in the button to be invoked, which in
+turn causes the button's associated Tcl command to be executed,
+which in turn causes the button to be deleted, which in turn causes
+the button's widget record to be de-allocated.
+Unfortunately, when the Tcl command returns, the button's
+event-handling procedure will need to reference the
+button's widget record.
+Because of this, the widget record must not be freed as part of the
+deletion, but must be retained until the event-handling procedure has
+finished with it.
+In other situations where the widget is deleted, it may be possible
+to free the widget record immediately.
+.PP
+\fBTcl_Preserve\fR and \fBTcl_Release\fR
+implement short-term reference counts for their \fIclientData\fR
+argument.
+The \fIclientData\fR argument identifies an object and usually
+consists of the address of a structure.
+The reference counts guarantee that an object will not be freed
+until each call to \fBTcl_Preserve\fR for the object has been
+matched by calls to \fBTcl_Release\fR.
+There may be any number of unmatched \fBTcl_Preserve\fR calls
+in effect at once.
+.PP
+\fBTcl_EventuallyFree\fR is invoked to free up its \fIclientData\fR
+argument.
+It checks to see if there are unmatched \fBTcl_Preserve\fR calls
+for the object.
+If not, then \fBTcl_EventuallyFree\fR calls \fIfreeProc\fR immediately.
+Otherwise \fBTcl_EventuallyFree\fR records the fact that \fIclientData\fR
+needs eventually to be freed.
+When all calls to \fBTcl_Preserve\fR have been matched with
+calls to \fBTcl_Release\fR then \fIfreeProc\fR will be called by
+\fBTcl_Release\fR to do the cleanup.
+.PP
+All the work of freeing the object is carried out by \fIfreeProc\fR.
+\fIFreeProc\fR must have arguments and result that match the
+type \fBTcl_FreeProc\fR:
+.CS
+typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
+.CE
+The \fIblockPtr\fR argument to \fIfreeProc\fR will be the
+same as the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR.
+The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
+\fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical
+reasons, but the value is the same.
+.PP
+This mechanism can be used to solve the problem described above
+by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around
+actions that may cause undesired storage re-allocation. The
+mechanism is intended only for short-term use (i.e. while procedures
+are pending on the stack); it will not work efficiently as a
+mechanism for long-term reference counts.
+The implementation does not depend in any way on the internal
+structure of the objects being freed; it keeps the reference
+counts in a separate structure.
+
+.SH KEYWORDS
+free, reference count, storage
diff --git a/tk/doc/QWinEvent.3 b/tk/doc/QWinEvent.3
index 35ce8ca6e15..a07d399152a 100644
--- a/tk/doc/QWinEvent.3
+++ b/tk/doc/QWinEvent.3
@@ -40,3 +40,4 @@ documentation for \fBTcl_QueueEvent\fR for details.
.SH KEYWORDS
callback, clock, handler, modal timeout
+
diff --git a/tk/doc/Restack.3 b/tk/doc/Restack.3
index 6389d09d36f..c7e41d3bab9 100644
--- a/tk/doc/Restack.3
+++ b/tk/doc/Restack.3
@@ -47,3 +47,4 @@ Both of these values are defined by the include file <X11/Xlib.h>.
.SH KEYWORDS
above, below, obscure, stacking order
+
diff --git a/tk/doc/RestrictEv.3 b/tk/doc/RestrictEv.3
index cb5653fe03a..d9508a15219 100644
--- a/tk/doc/RestrictEv.3
+++ b/tk/doc/RestrictEv.3
@@ -79,3 +79,4 @@ queue. Instead, call \fBTk_RestrictEvents\fR to set up a filter,
then call \fBTk_DoOneEvent\fR to retrieve the desired event(s).
.SH KEYWORDS
delay, event, filter, restriction
+
diff --git a/tk/doc/SetAppName.3 b/tk/doc/SetAppName.3
index 978ab823d17..0601c802095 100644
--- a/tk/doc/SetAppName.3
+++ b/tk/doc/SetAppName.3
@@ -63,3 +63,4 @@ functionality of \fBTk_SetAppName\fR.
.SH KEYWORDS
application, name, register, send command
+
diff --git a/tk/doc/SetClass.3 b/tk/doc/SetClass.3
index 9b2f9814724..47baa9f6c49 100644
--- a/tk/doc/SetClass.3
+++ b/tk/doc/SetClass.3
@@ -59,3 +59,4 @@ If \fItkwin\fR has not yet been given a class, then
.SH KEYWORDS
class, unique identifier, window, window manager
+
diff --git a/tk/doc/SetGrid.3 b/tk/doc/SetGrid.3
index d867ca4c3ee..6602b632876 100644
--- a/tk/doc/SetGrid.3
+++ b/tk/doc/SetGrid.3
@@ -65,3 +65,4 @@ management.
.SH KEYWORDS
grid, window, window manager
+
diff --git a/tk/doc/SetOptions.3 b/tk/doc/SetOptions.3
new file mode 100644
index 00000000000..dcb8f969719
--- /dev/null
+++ b/tk/doc/SetOptions.3
@@ -0,0 +1,503 @@
+'\"
+'\" 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 or \fBNone\fR, depending on the type of the option.
+If the flag is not set then empty strings will result
+in errors.
+TK_OPTION_NULL_OK is typically used to allow a
+feature to be turned off entirely, e.g. set a cursor value to
+\fBNone\fR so that a window simply inherits its parent's cursor.
+Not all option types support the TK_OPTION_NULL_OK
+flag; for those that do, there is an explicit indication of that fact
+in the descriptions below.
+.PP
+The \fItype\fR field of each Tk_OptionSpec structure determines
+how to parse the value of that configuration option. The
+legal value for \fItype\fR, and the corresponding actions, are
+described below. If the type requires a \fItkwin\fR value to be
+passed into procedures like \fBTk_SetOptions\fR, or if it uses
+the \fIclientData\fR field of the Tk_OptionSpec, then it is indicated
+explicitly; if not mentioned, the type requires neither \fItkwin\fR
+nor \fIclientData\fR.
+.TP
+\fBTK_OPTION_ANCHOR\fR
+The value must be a standard anchor position such as \fBne\fR or
+\fBcenter\fR. The internal form is a Tk_Anchor value like the ones
+returned by \fBTk_GetAnchorFromObj\fR.
+.TP
+\fBTK_OPTION_BITMAP\fR
+The value must be a standard Tk bitmap name. The internal form is a
+Pixmap token like the ones returned by \fBTk_AllocBitmapFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_BOOLEAN\fR
+The value must be a standard boolean value such as \fBtrue\fR or
+\fBno\fR. The internal form is an integer with value 0 or 1.
+.TP
+\fBTK_OPTION_BORDER\fR
+The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR.
+The internal form is a Tk_3DBorder token like the ones returned
+by \fBTk_Alloc3DBorderFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_COLOR\fR
+The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR.
+The internal form is an (XColor *) token like the ones returned by
+\fBTk_AllocColorFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_CURSOR\fR
+The value must be a standard cursor name such as \fBcross\fR or \fB@foo\fR.
+The internal form is a Tk_Cursor token like the ones returned by
+\fBTk_AllocCursorFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and when the option is set the cursor
+for the window is changed by calling \fBXDefineCursor\fR. This
+option type also supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_DOUBLE\fR
+The string value must be a floating-point number in
+the format accepted by \fBstrtol\fR. The internal form is a C
+\fBdouble\fR value.
+.TP
+\fBTK_OPTION_END\fR
+Marks the end of the template. There must be a Tk_OptionSpec structure
+with \fItype\fR TK_OPTION_END at the end of each template. If the
+\fIclientData\fR field of this structure isn't NULL, then it points to
+an additional array of Tk_OptionSpec's, which is itself terminated by
+another TK_OPTION_END entry. Templates may be chained arbitrarily
+deeply. This feature allows common options to be shared by several
+widget classes.
+.TP
+\fBTK_OPTION_FONT\fR
+The value must be a standard font name such as \fBTimes 16\fR.
+The internal form is a Tk_Font handle like the ones returned by
+\fBTk_AllocFontFromObj\fR.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR, and it supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_INT\fR
+The string value must be an integer in the format accepted by
+\fBstrtol\fR (e.g. \fB0\fR and \fB0x\fR prefixes may be used to
+specify octal or hexadecimal numbers, respectively). The internal
+form is a C \fBint\fR value.
+.TP
+\fBTK_OPTION_JUSTIFY\fR
+The value must be a standard justification value such as \fBleft\fR.
+The internal form is a Tk_Justify like the values returned by
+\fBTk_GetJustifyFromObj\fR.
+.TP
+\fBTK_OPTION_PIXELS\fR
+The value must specify a screen distance such as \fB2i\fR or \fB6.4\fR.
+The internal form is an integer value giving a
+distance in pixels, like the values returned by
+\fBTk_GetPixelsFromObj\fR. Note: if the \fIobjOffset\fR field isn't
+used then information about the original value of this option will be lost.
+See \fBOBJOFFSET VS. INTERNALOFFSET\fR below for details.
+.TP
+\fBTK_OPTION_RELIEF\fR
+The value must be standard relief such as \fBraised\fR.
+The internal form is an integer relief value such as
+TK_RELIEF_RAISED.
+.TP
+\fBTK_OPTION_STRING\fR
+The value may be any string. The internal form is a (char *) pointer
+that points to a dynamically allocated copy of the value.
+This option type supports the TK_OPTION_NULL_OK flag.
+.TP
+\fBTK_OPTION_STRING_TABLE\fR
+For this type, \fIclientData\fR is a pointer to an array of strings
+suitable for passing to \fBTcl_GetIndexFromObj\fR. The value must
+be one of the strings in the table, or a unique abbreviation of
+one of the strings. The internal form is an integer giving the index
+into the table of the matching string, like the return value
+from \fBTcl_GetStringFromObj\fR.
+.TP
+\fBTK_OPTION_SYNONYM\fR
+This type is used to provide alternative names for an option (for
+example, \fB\-bg\fR is often used as a synonym for \fB\-background\fR).
+The \fBclientData\fR field is a (char *) pointer that gives
+the name of another option in the same table. Whenever the
+synonym option is used, the information from the other option
+will be used instead.
+.TP
+\fBTK_OPTION_WINDOW\fR
+The value must be a window path name. The internal form is a
+\fBTk_Window\fR token for the window.
+This option type requires \fItkwin\fR to be supplied to procedures
+such as \fBTk_SetOptions\fR (in order to identify the application),
+and it supports the TK_OPTION_NULL_OK flag.
+
+.SH "STORAGE MANAGEMENT ISSUES"
+.PP
+If a field of a widget record has its offset stored in the \fIobjOffset\fR
+or \fIinternalOffset\fR field of a Tk_OptionSpec structure then the
+procedures described here will handle all of the storage allocation and
+resource management issues associated with the field. When the value
+of an option is changed, \fBTk_SetOptions\fR (or \fBTk_FreeSavedOptions\fR
+will automatically free any resources associated with the old value, such as
+Tk_Fonts for TK_OPTION_FONT options or dynamically allocated memory for
+TK_OPTION_STRING options. For an option stored as an object using the
+\fIobjOffset\fR field of a Tk_OptionSpec, the widget record shares the
+object pointed to by the \fIobjv\fR value from the call to
+\fBTk_SetOptions\fR. The reference count for this object is incremented
+when a pointer to it is stored in the widget record and decremented when
+the option is modified. When the widget is deleted
+\fBTk_FreeConfigOptions\fR should be invoked; it will free the resources
+associated with all options and decrement reference counts for any
+objects.
+.PP
+However, the widget code is responsible for storing NULL or \fBNone\fR in
+all pointer and token fields before invoking \fBTk_InitOptions\fR.
+This is needed to allow proper cleanup in the rare case where
+an error occurs in \fBTk_InitOptions\fR.
+
+.SH "OBJOFFSET VS. INTERNALOFFSET"
+.PP
+In most cases it is simplest to use the \fIinternalOffset\fR field of
+a Tk_OptionSpec structure and not the \fIobjOffset\fR field. This
+makes the internal form of the value immediately available to the
+widget code so the value doesn't have to be extracted from an object
+each time it is used. However, there are two cases where the
+\fIobjOffset\fR field is useful. The first case is for
+TK_OPTION_PIXELS options. In this case, the internal form is
+an integer pixel value that is valid only for a particular screen.
+If the value of the option is retrieved, it will be returned as a simple
+number. For example, after the command \fB.b configure \-borderwidth 2m\fR,
+the command \fB.b configure \-borderwidth\fR might return 7, which is the
+integer pixel value corresponding to \fB2m\fR. Unfortunately, this loses
+the original screen-independent value. Thus for TK_OPTION_PIXELS options
+it is better to use the \fIobjOffset\fR field. In this case the original
+value of the option is retained in the object and can be returned when
+the option is retrieved. In most cases it is convenient to use the
+\fIinternalOffset\fR field field as well, so that the integer value is
+immediately available for use in the widget code (alternatively,
+\fBTk_GetPixelsFromObj\fR can be used to extract the integer value from
+the object whenever it is needed). Note: the problem of losing information
+on retrievals exists only for TK_OPTION_PIXELS options.
+.PP
+The second reason to use the \fIobjOffset\fR field is in order to
+implement new types of options not supported by these procedures.
+To implement a new type of option, use TK_OPTION_STRING as
+the type in the Tk_OptionSpec structure and set the \fIobjOffset\fR field
+but not the \fIinternalOffset\fR field. Then, after calling
+\fBTk_SetOptions\fR, convert the object to internal form yourself.
+
+.SH KEYWORDS
+anchor, bitmap, boolean, border, color, configuration option,
+cursor, double, font, integer, justify,
+pixels, relief, screen distance, synonym
+
diff --git a/tk/doc/SetVisual.3 b/tk/doc/SetVisual.3
index 8895d3a36f9..f349fe7b669 100644
--- a/tk/doc/SetVisual.3
+++ b/tk/doc/SetVisual.3
@@ -52,3 +52,4 @@ call \fBTk_SetWindowColormap\fR instead.
.SH KEYWORDS
colormap, depth, visual
+
diff --git a/tk/doc/Sleep.3 b/tk/doc/Sleep.3
new file mode 100644
index 00000000000..0c7956a5b30
--- /dev/null
+++ b/tk/doc/Sleep.3
@@ -0,0 +1,37 @@
+'\"
+'\" Copyright (c) 1990 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) Sleep.3 1.3 96/03/25 20:07:21
+'\"
+.so man.macros
+.TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_Sleep \- delay execution for a given number of milliseconds
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_Sleep\fR(\fIms\fR)
+.SH ARGUMENTS
+.AP int ms in
+Number of milliseconds to sleep.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure delays the calling process by the number of
+milliseconds given by the \fIms\fR parameter and returns
+after that time has elapsed. It is typically used for things
+like flashing a button, where the delay is short and the
+application needn't do anything while it waits. For longer
+delays where the application needs to respond to other events
+during the delay, the procedure \fBTcl_CreateTimerHandler\fR
+should be used instead of \fBTcl_Sleep\fR.
+
+.SH KEYWORDS
+sleep, time, wait
diff --git a/tk/doc/StrictMotif.3 b/tk/doc/StrictMotif.3
index 24c99051a2a..4b12e63b0b0 100644
--- a/tk/doc/StrictMotif.3
+++ b/tk/doc/StrictMotif.3
@@ -39,3 +39,4 @@ faster access to the variable's value than could be had by calling
.SH KEYWORDS
Motif compliance, tk_strictMotif variable
+
diff --git a/tk/doc/Tcl.n b/tk/doc/Tcl.n
new file mode 100644
index 00000000000..610fe1bbb07
--- /dev/null
+++ b/tk/doc/Tcl.n
@@ -0,0 +1,181 @@
+'\"
+'\" Copyright (c) 1993 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) Tcl.n 1.128 96/08/26 12:59:50
+'
+.so man.macros
+.TH Tcl n "" Tcl "Tcl Built-In Commands"
+.BS
+.SH NAME
+Tcl \- Summary of Tcl language syntax.
+.BE
+
+.SH DESCRIPTION
+.PP
+The following rules define the syntax and semantics of the Tcl language:
+.IP [1]
+A Tcl script is a string containing one or more commands.
+Semi-colons and newlines are command separators unless quoted as
+described below.
+Close brackets are command terminators during command substitution
+(see below) unless quoted.
+.IP [2]
+A command is evaluated in two steps.
+First, the Tcl interpreter breaks the command into \fIwords\fR
+and performs substitutions as described below.
+These substitutions are performed in the same way for all
+commands.
+The first word is used to locate a command procedure to
+carry out the command, then all of the words of the command are
+passed to the command procedure.
+The command procedure is free to interpret each of its words
+in any way it likes, such as an integer, variable name, list,
+or Tcl script.
+Different commands interpret their words differently.
+.IP [3]
+Words of a command are separated by white space (except for
+newlines, which are command separators).
+.IP [4]
+If the first character of a word is double-quote (``"'') then
+the word is terminated by the next double-quote character.
+If semi-colons, close brackets, or white space characters
+(including newlines) appear between the quotes then they are treated
+as ordinary characters and included in the word.
+Command substitution, variable substitution, and backslash substitution
+are performed on the characters between the quotes as described below.
+The double-quotes are not retained as part of the word.
+.IP [5]
+If the first character of a word is an open brace (``{'') then
+the word is terminated by the matching close brace (``}'').
+Braces nest within the word: for each additional open
+brace there must be an additional close brace (however,
+if an open brace or close brace within the word is
+quoted with a backslash then it is not counted in locating the
+matching close brace).
+No substitutions are performed on the characters between the
+braces except for backslash-newline substitutions described
+below, nor do semi-colons, newlines, close brackets,
+or white space receive any special interpretation.
+The word will consist of exactly the characters between the
+outer braces, not including the braces themselves.
+.IP [6]
+If a word contains an open bracket (``['') then Tcl performs
+\fIcommand substitution\fR.
+To do this it invokes the Tcl interpreter recursively to process
+the characters following the open bracket as a Tcl script.
+The script may contain any number of commands and must be terminated
+by a close bracket (``]'').
+The result of the script (i.e. the result of its last command) is
+substituted into the word in place of the brackets and all of the
+characters between them.
+There may be any number of command substitutions in a single word.
+Command substitution is not performed on words enclosed in braces.
+.IP [7]
+If a word contains a dollar-sign (``$'') then Tcl performs \fIvariable
+substitution\fR: the dollar-sign and the following characters are
+replaced in the word by the value of a variable.
+Variable substitution may take any of the following forms:
+.RS
+.TP 15
+\fB$\fIname\fR
+\fIName\fR is the name of a scalar variable; the name is terminated
+by any character that isn't a letter, digit, or underscore.
+.TP 15
+\fB$\fIname\fB(\fIindex\fB)\fR
+\fIName\fR gives the name of an array variable and \fIindex\fR gives
+the name of an element within that array.
+\fIName\fR must contain only letters, digits, and underscores.
+Command substitutions, variable substitutions, and backslash
+substitutions are performed on the characters of \fIindex\fR.
+.TP 15
+\fB${\fIname\fB}\fR
+\fIName\fR is the name of a scalar variable. It may contain any
+characters whatsoever except for close braces.
+.LP
+There may be any number of variable substitutions in a single word.
+Variable substitution is not performed on words enclosed in braces.
+.RE
+.IP [8]
+If a backslash (``\e'') appears within a word then
+\fIbackslash substitution\fR occurs.
+In all cases but those described below the backslash is dropped and
+the following character is treated as an ordinary
+character and included in the word.
+This allows characters such as double quotes, close brackets,
+and dollar signs to be included in words without triggering
+special processing.
+The following table lists the backslash sequences that are
+handled specially, along with the value that replaces each sequence.
+.RS
+.TP 6
+\e\fBa\fR
+Audible alert (bell) (0x7).
+.TP 6
+\e\fBb\fR
+Backspace (0x8).
+.TP 6
+\e\fBf\fR
+Form feed (0xc).
+.TP 6
+\e\fBn\fR
+Newline (0xa).
+.TP 6
+\e\fBr\fR
+Carriage-return (0xd).
+.TP 6
+\e\fBt\fR
+Tab (0x9).
+.TP 6
+\e\fBv\fR
+Vertical tab (0xb).
+.TP 6
+\e\fB<newline>\fIwhiteSpace\fR
+A single space character replaces the backslash, newline, and all
+spaces and tabs after the newline.
+This backslash sequence is unique in that it is replaced in a separate
+pre-pass before the command is actually parsed.
+This means that it will be replaced even when it occurs between
+braces, and the resulting space will be treated as a word separator
+if it isn't in braces or quotes.
+.TP 6
+\e\e
+Backslash (``\e'').
+.TP 6
+\e\fIooo\fR
+The digits \fIooo\fR (one, two, or three of them) give the octal value of
+the character.
+.TP 6
+\e\fBx\fIhh\fR
+The hexadecimal digits \fIhh\fR give the hexadecimal value of
+the character. Any number of digits may be present.
+.LP
+Backslash substitution is not performed on words enclosed in braces,
+except for backslash-newline as described above.
+.RE
+.IP [9]
+If a hash character (``#'') appears at a point where Tcl is
+expecting the first character of the first word of a command,
+then the hash character and the characters that follow it, up
+through the next newline, are treated as a comment and ignored.
+The comment character only has significance when it appears
+at the beginning of a command.
+.IP [10]
+Each character is processed exactly once by the Tcl interpreter
+as part of creating the words of a command.
+For example, if variable substitution occurs then no further
+substitutions are performed on the value of the variable; the
+value is inserted into the word verbatim.
+If command substitution occurs then the nested command is
+processed entirely by the recursive call to the Tcl interpreter;
+no substitutions are performed before making the recursive
+call and no additional substitutions are performed on the result
+of the nested script.
+.IP [11]
+Substitutions do not affect the word boundaries of a command.
+For example, during variable substitution the entire value of
+the variable becomes part of a single word, even if the variable's
+value contains spaces.
diff --git a/tk/doc/TextLayout.3 b/tk/doc/TextLayout.3
index 31665ffce5c..bb00bb480aa 100644
--- a/tk/doc/TextLayout.3
+++ b/tk/doc/TextLayout.3
@@ -7,7 +7,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH Tk_ComputeTextLayout 3 "" Tk "Tk Library Procedures"
+.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.
@@ -55,7 +55,10 @@ lifetime of the text layout.
.AP int numChars in
The number of characters to consider from \fIstring\fR. If
\fInumChars\fR is less than 0, then assumes \fIstring\fR is null
-terminated and uses \fBstrlen(\fIstring\fB)\fR.
+.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
@@ -133,7 +136,14 @@ 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.
+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
@@ -182,7 +192,7 @@ 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
+\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
@@ -268,3 +278,4 @@ actually drawn \- they are merely placeholders maintained in the
\fIlayout\fR.
.SH KEYWORDS
font
+
diff --git a/tk/doc/TkInitStubs.3 b/tk/doc/TkInitStubs.3
new file mode 100644
index 00000000000..c8d6fc28181
--- /dev/null
+++ b/tk/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.1 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_InitStubs \- initialize the Tk stubs mechanism
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+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.1.a\fR and \fIlibtkstub8.1.a\fR; on Windows
+platforms, the library names are
+\fItclstub81.lib\fR and \fItkstub81.lib\fR.
+.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/tk/doc/Tk_Init.3 b/tk/doc/Tk_Init.3
index abb86b3a8d1..4587f5012b5 100644
--- a/tk/doc/Tk_Init.3
+++ b/tk/doc/Tk_Init.3
@@ -45,3 +45,4 @@ its command-line arguments).
.SH KEYWORDS
application, initialization, load, main window
+
diff --git a/tk/doc/Tk_Main.3 b/tk/doc/Tk_Main.3
index 72f506638ed..813f6ba6f88 100644
--- a/tk/doc/Tk_Main.3
+++ b/tk/doc/Tk_Main.3
@@ -59,3 +59,4 @@ for \fBTcl_AppInit\fR.
.SH KEYWORDS
application-specific initialization, command-line arguments, main program
+
diff --git a/tk/doc/WindowId.3 b/tk/doc/WindowId.3
index fc9e503caee..26cf5828fdb 100644
--- a/tk/doc/WindowId.3
+++ b/tk/doc/WindowId.3
@@ -11,7 +11,7 @@
.TH Tk_WindowId 3 "" Tk "Tk Library Procedures"
.BS
.SH NAME
-Tk_WindowId, Tk_Parent, Tk_Display, Tk_DisplayName, Tk_ScreenNumber, Tk_Screen, Tk_X, Tk_Y, Tk_Width, Tk_Height, Tk_Changes, Tk_Attributes, Tk_IsMapped, Tk_IsTopLevel, Tk_ReqWidth, Tk_ReqHeight, Tk_InternalBorderWidth, Tk_Visual, Tk_Depth, Tk_Colormap \- retrieve information from Tk's local data structure
+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_InternalBorderWidth, Tk_Visual, Tk_Depth, Tk_Colormap \- retrieve information from Tk's local data structure
.SH SYNOPSIS
.nf
\fB#include <tk.h>\fR
@@ -53,6 +53,12 @@ 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
@@ -83,7 +89,7 @@ Token for window.
.SH DESCRIPTION
.PP
-\fBTk_WindowID\fR and the other names listed above are
+\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
@@ -120,6 +126,14 @@ 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
@@ -149,3 +163,4 @@ they may be overridden by calling \fBTk_SetWindowVisual\fR.
attributes, colormap, depth, display, height, geometry manager,
identifier, mapped, requested size, screen, top-level,
visual, width, window, x, y
+
diff --git a/tk/doc/after.n b/tk/doc/after.n
new file mode 100644
index 00000000000..cf4aaeb75c7
--- /dev/null
+++ b/tk/doc/after.n
@@ -0,0 +1,109 @@
+'\"
+'\" Copyright (c) 1990-1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) after.n 1.4 96/03/25 20:09:33
+'\"
+.so man.macros
+.TH after n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+after \- Execute a command after a time delay
+.SH SYNOPSIS
+\fBafter \fIms\fR
+.sp
+\fBafter \fIms \fR?\fIscript script script ...\fR?
+.sp
+\fBafter cancel \fIid\fR
+.sp
+\fBafter cancel \fIscript script script ...\fR
+.sp
+\fBafter idle \fR?\fIscript script script ...\fR?
+.sp
+\fBafter info \fR?\fIid\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is used to delay execution of the program or to execute
+a command in background sometime in the future. It has several forms,
+depending on the first argument to the command:
+.TP
+\fBafter \fIms\fR
+\fIMs\fR must be an integer giving a time in milliseconds.
+The command sleeps for \fIms\fR milliseconds and then returns.
+While the command is sleeping the application does not respond to
+events.
+.TP
+\fBafter \fIms \fR?\fIscript script script ...\fR?
+In this form the command returns immediately, but it arranges
+for a Tcl command to be executed \fIms\fR milliseconds later as an
+event handler.
+The command will be executed exactly once, at the given time.
+The delayed command is formed by concatenating all the \fIscript\fR
+arguments in the same fashion as the \fBconcat\fR command.
+The command will be executed at global level (outside the context
+of any Tcl procedure).
+If an error occurs while executing the delayed command then the
+\fBbgerror\fR mechanism is used to report the error.
+The \fBafter\fR command returns an identifier that can be used
+to cancel the delayed command using \fBafter cancel\fR.
+.TP
+\fBafter cancel \fIid\fR
+Cancels the execution of a delayed command that
+was previously scheduled.
+\fIId\fR indicates which command should be canceled; it must have
+been the return value from a previous \fBafter\fR command.
+If the command given by \fIid\fR has already been executed then
+the \fBafter cancel\fR command has no effect.
+.TP
+\fBafter cancel \fIscript script ...\fR
+This command also cancels the execution of a delayed command.
+The \fIscript\fR arguments are concatenated together with space
+separators (just as in the \fBconcat\fR command).
+If there is a pending command that matches the string, it is
+cancelled and will never be executed; if no such command is
+currently pending then the \fBafter cancel\fR command has no effect.
+.TP
+\fBafter idle \fIscript \fR?\fIscript script ...\fR?
+Concatenates the \fIscript\fR arguments together with space
+separators (just as in the \fBconcat\fR command), and arranges
+for the resulting script to be evaluated later as an idle callback.
+The script will be run exactly once, the next time the event
+loop is entered and there are no events to process.
+The command returns an identifier that can be used
+to cancel the delayed command using \fBafter cancel\fR.
+If an error occurs while executing the script then the
+\fBbgerror\fR mechanism is used to report the error.
+.TP
+\fBafter info \fR?\fIid\fR?
+This command returns information about existing event handlers.
+If no \fIid\fR argument is supplied, the command returns
+a list of the identifiers for all existing
+event handlers created by the \fBafter\fR command for this
+interpreter.
+If \fIid\fR is supplied, it specifies an existing handler;
+\fIid\fR must have been the return value from some previous call
+to \fBafter\fR and it must not have triggered yet or been cancelled.
+In this case the command returns a list with two elements.
+The first element of the list is the script associated
+with \fIid\fR, and the second element is either
+\fBidle\fR or \fBtimer\fR to indicate what kind of event
+handler it is.
+.LP
+The \fBafter \fIms\fR and \fBafter idle\fR forms of the command
+assume that the application is event driven: the delayed commands
+will not be executed unless the application enters the event loop.
+In applications that are not normally event-driven, such as
+\fBtclsh\fR, the event loop can be entered with the \fBvwait\fR
+and \fBupdate\fR commands.
+
+.SH "SEE ALSO"
+bgerror
+
+.SH KEYWORDS
+cancel, delay, idle callback, sleep, time
diff --git a/tk/doc/bell.n b/tk/doc/bell.n
index 75db0241f91..312983d360a 100644
--- a/tk/doc/bell.n
+++ b/tk/doc/bell.n
@@ -32,3 +32,4 @@ screen becomes visible again.
.SH KEYWORDS
beep, bell, ring
+
diff --git a/tk/doc/bind.n b/tk/doc/bind.n
index bdaab5784d6..6618f446c05 100644
--- a/tk/doc/bind.n
+++ b/tk/doc/bind.n
@@ -521,3 +521,4 @@ bgerror
.SH KEYWORDS
form, manual
+
diff --git a/tk/doc/bindtags.n b/tk/doc/bindtags.n
index 20e5291f459..1f6a30a5323 100644
--- a/tk/doc/bindtags.n
+++ b/tk/doc/bindtags.n
@@ -79,3 +79,4 @@ bind
.SH KEYWORDS
binding, event, tag
+
diff --git a/tk/doc/bitmap.n b/tk/doc/bitmap.n
index 0fa1c5afda9..21c4135337a 100644
--- a/tk/doc/bitmap.n
+++ b/tk/doc/bitmap.n
@@ -112,3 +112,4 @@ this case the command returns an empty string.
.SH KEYWORDS
bitmap, image
+
diff --git a/tk/doc/button.n b/tk/doc/button.n
index dc95b5da3c6..6cda7367623 100644
--- a/tk/doc/button.n
+++ b/tk/doc/button.n
@@ -174,3 +174,4 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
button, widget
+
diff --git a/tk/doc/canvas.n b/tk/doc/canvas.n
index a1120bea1f0..b4c7d90c6d1 100644
--- a/tk/doc/canvas.n
+++ b/tk/doc/canvas.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
@@ -8,7 +9,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH canvas n 4.0 Tk "Tk Built-In Commands"
+.TH canvas n 8.3 Tk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -16,11 +17,11 @@ canvas \- Create and manipulate canvas widgets
.SH SYNOPSIS
\fBcanvas\fR \fIpathName \fR?\fIoptions\fR?
.SO
-\-background \-highlightthickness \-insertwidth \-takefocus
-\-borderwidth \-insertbackground \-relief \-xscrollcommand
-\-cursor \-insertborderwidth \-selectbackground \-yscrollcommand
-\-highlightbackground \-insertofftime \-selectborderwidth
-\-highlightcolor \-insertontime \-selectforeground
+\-background \-highlightthickness \-insertwidth \-relief
+\-borderwidth \-insertbackground \-state
+\-cursor \-insertborderwidth \-selectbackground \-takefocus
+\-highlightbackground \-insertofftime \-selectborderwidth \-xscrollcommand
+\-highlightcolor \-insertontime \-selectforeground \-yscrollcommand
.SE
.SH "WIDGET-SPECIFIC OPTIONS"
.OP \-closeenough closeEnough CloseEnough
@@ -44,11 +45,20 @@ 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.
-.br
.OP \-xscrollincrement xScrollIncrement ScrollIncrement
Specifies an increment for horizontal scrolling, in any of the usual forms
permitted for screen distances. If the value of this option is greater
@@ -152,6 +162,19 @@ 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
@@ -192,34 +215,45 @@ described below, but they may not be rotated.
.PP
Text items support the notion of an \fIindex\fR for identifying
particular positions within the item.
-Indices are used for commands such as inserting text, deleting
-a range of characters, and setting the insertion cursor position.
-An index may be specified in any of a number of ways, and
-different types of items may support different forms for
-specifying indices.
+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.
+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.
+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 just after the last one in the item
-(same as the number of characters in the item).
+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.
+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.
@@ -230,13 +264,45 @@ Refers to the last selected character in the item.
If the selection isn't in this item then this form is illegal.
.TP 10
\fB@\fIx,y\fR
-Refers to the character at the point given by \fIx\fR and
+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 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 "WIDGET COMMAND"
.PP
The \fBcanvas\fR command creates a new Tcl command whose
@@ -351,7 +417,6 @@ returns a list of all the sequences for which bindings have been
defined for \fItagOrId\fR.
.RS
.PP
-.VS
The only events for which bindings may be specified are those related to
the mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR,
\fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR) or virtual events.
@@ -365,7 +430,6 @@ any (see the \fBfocus\fR widget command below for more on this). If a
virtual event is used in a binding, that binding can trigger only if the
virtual event is defined by an underlying mouse-related or
keyboard-related event.
-.VE
.PP
It is possible for multiple bindings to match a particular event.
This could occur, for example, if one binding is associated with the
@@ -441,13 +505,13 @@ on the syntax of this command.
This command returns the id for the new item.
.TP
\fIpathName \fBdchars \fItagOrId first \fR?\fIlast\fR?
-For each item given by \fItagOrId\fR, delete the characters
-in the range given by \fIfirst\fR and \fIlast\fR,
-inclusive.
+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
-text operations, then they are ignored.
-\fIFirst\fR and \fIlast\fR are indices of characters
-within the item(s) as described in INDICES above.
+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
@@ -509,8 +573,7 @@ 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
+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.
@@ -527,16 +590,22 @@ 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 within the item, inclusive.
+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 insertion then \fIstring\fR is inserted into the item's
-text just before the character whose index is \fIbeforeThis\fR.
+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.
@@ -598,14 +667,12 @@ Generate a Postscript representation for part or all of the canvas.
If the \fB\-file\fR option is specified then the Postscript is written
to a file and an empty string is returned; otherwise the Postscript
is returned as the result of the command.
-.VS
If the interpreter that owns the canvas is marked as safe, the operation
will fail because safe interpreters are not allowed to write files.
If the \fB\-channel\fR option is specified, the argument denotes the name
of a channel already opened for writing. The Postscript is written to
that channel, and the channel is left open for further writing at the end
of the operation.
-.VE
The Postscript is created in Encapsulated Postscript form using
version 3.0 of the Document Structuring Conventions.
Note: by default Postscript is only generated for information that
@@ -775,12 +842,13 @@ Typically this command is associated with a mouse button press in
the widget and \fIx\fR and \fIy\fR are the coordinates of the
mouse. It returns an empty string.
.TP
-\fIpathName \fBscan dragto \fIx y\fR.
+\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 10 times the
-difference in coordinates. This command is typically associated
+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.
@@ -939,8 +1007,121 @@ for items of that type, which may be used in the
Most items don't support indexing or selection or the commands
related to them, such as \fBindex\fR and \fBinsert\fR.
Where items do support these facilities, it is noted explicitly
-in the descriptions below (at present, only text items provide
-this support).
+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 state, the active
+state, and the disabled state of an arc 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 into the pattern provided by the \fB\-dash\fR option.
+\fB\-dashoffset\fR is ignored if there is no \fB-dash\fR pattern.
+.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 in stead. 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
@@ -960,7 +1141,33 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for arcs:
+.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.
@@ -970,42 +1177,12 @@ from the starting angle given by the \fB\-start\fR option.
If it is greater than 360 or less than -360, then \fIdegrees\fR
modulo 360 is used as the extent.
.TP
-\fB\-fill \fIcolor\fR
-Fill the region of the arc with \fIcolor\fR.
-\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
-If \fIcolor\fR is an empty string (the default), then
-then the arc will not be filled.
-.TP
-\fB\-outline \fIcolor\fR
-\fIColor\fR specifies a color to use for drawing the arc's
-outline; it may have any of the forms accepted by \fBTk_GetColor\fR.
-This option defaults to \fBblack\fR. If \fIcolor\fR is specified
-as an empty string then no outline is drawn for the arc.
-.TP
-\fB\-outlinestipple \fIbitmap\fR
-Indicates that the outline for the arc should be drawn with a stipple pattern;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If the \fB\-outline\fR option hasn't been specified then this option
-has no effect.
-If \fIbitmap\fR is an empty string (the default), then the outline is drawn
-in a solid fashion.
-.TP
\fB\-start \fIdegrees\fR
Specifies the beginning of the angular range occupied by the
arc.
\fIDegrees\fR is given in units of degrees measured counter-clockwise
from the 3-o'clock position; it may be either positive or negative.
.TP
-\fB\-stipple \fIbitmap\fR
-Indicates that the arc should be filled in a stipple pattern;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If the \fB\-fill\fR option hasn't been specified then this option
-has no effect.
-If \fIbitmap\fR is an empty string (the default), then filling is done
-in a solid fashion.
-.TP
\fB\-style \fItype\fR
Specifies how to draw the arc. If \fItype\fR is \fBpieslice\fR
(the default) then the arc's region is defined by a section
@@ -1017,21 +1194,6 @@ connecting the two end points of the perimeter section.
If \fItype\fR is \fBarc\fR then the arc's region consists of
a section of the perimeter alone.
In this last case the \fB\-fill\fR option is ignored.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
-\fB\-width \fIoutlineWidth\fR
-Specifies the width of the outline to be drawn around
-the arc's region, in any of the forms described in the COORDINATES
-section above.
-If the \fB\-outline\fR option has been specified as an empty string
-then this option has no effect.
-Wide outlines will be drawn centered on the edges of the arc's region.
-This option defaults to 1.0.
.SH "BITMAP ITEMS"
.PP
@@ -1049,7 +1211,13 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for bitmaps:
+.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
@@ -1061,28 +1229,35 @@ its top center point is at the positioning point.
This option defaults to \fBcenter\fR.
.TP
\fB\-background \fIcolor\fR
-Specifies a color to use for each of the bitmap pixels
-whose value is 0.
+.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
-Specifies the bitmap to display in the item.
+.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
-Specifies a color to use for each of the bitmap pixels
-whose value is 1.
+.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.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
.SH "IMAGE ITEMS"
.PP
@@ -1100,7 +1275,13 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for images:
+.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
@@ -1112,19 +1293,21 @@ its top center point is at the positioning point.
This option defaults to \fBcenter\fR.
.TP
\fB\-image \fIname\fR
-Specifies the name of the image to display in the item.
+.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.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item; it may be an empty list.
.SH "LINE ITEMS"
.PP
Items of type \fBline\fR appear on the display as one or more connected
line segments or curves.
+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?
@@ -1137,7 +1320,26 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for lines:
+.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
@@ -1169,12 +1371,6 @@ of the line.
If this option isn't specified then it defaults to \fBbutt\fR.
Where arrowheads are drawn the cap style is ignored.
.TP
-\fB\-fill \fIcolor\fR
-\fIColor\fR specifies a color to use for drawing the line; it may have
-any of the forms acceptable to \fBTk_GetColor\fR. It may also be an
-empty string, in which case the line will be transparent.
-This option defaults to \fBblack\fR.
-.TP
\fB\-joinstyle \fIstyle\fR
Specifies the ways in which joints are to be drawn at the vertices
of the line.
@@ -1196,26 +1392,6 @@ a curve by duplicating the end-points of the desired line segment.
Specifies the degree of smoothness desired for curves: each spline
will be approximated with \fInumber\fR line segments. This
option is ignored unless the \fB\-smooth\fR option is true.
-.TP
-\fB\-stipple \fIbitmap\fR
-Indicates that the line should be filled in a stipple pattern;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If \fIbitmap\fR is an empty string (the default), then filling is
-done in a solid fashion.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
-\fB\-width \fIlineWidth\fR
-\fILineWidth\fR specifies the width of the line, in any of the forms
-described in the COORDINATES section above.
-Wide lines will be drawn centered on the path specified by the
-points.
-If this option isn't specified then it defaults to 1.0.
.SH "OVAL ITEMS"
.PP
@@ -1238,77 +1414,87 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for ovals:
-.TP
-\fB\-fill \fIcolor\fR
-Fill the area of the oval with \fIcolor\fR.
-\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
-If \fIcolor\fR is an empty string (the default), then
-then the oval will not be filled.
-.TP
-\fB\-outline \fIcolor\fR
-\fIColor\fR specifies a color to use for drawing the oval's
-outline; it may have any of the forms accepted by \fBTk_GetColor\fR.
-This option defaults to \fBblack\fR.
-If \fIcolor\fR is an empty string then no outline will be
-drawn for the oval.
-.TP
-\fB\-stipple \fIbitmap\fR
-Indicates that the oval should be filled in a stipple pattern;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If the \fB\-fill\fR option hasn't been specified then this option
-has no effect.
-If \fIbitmap\fR is an empty string (the default), then filling is done
-in a solid fashion.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
-\fB\-width \fIoutlineWidth\fR
-\fIoutlineWidth\fR specifies the width of the outline to be drawn around
-the oval, in any of the forms described in the COORDINATES section above.
-If the \fB\-outline\fR option hasn't been specified then this option
-has no effect.
-Wide outlines are drawn centered on the oval path defined by
-\fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR.
-This option defaults to 1.0.
+.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?
.CE
The arguments \fIx1\fR through \fIyn\fR specify the coordinates for
-three or more points that define a closed polygon.
-The first and last points may be the same; whether they are or not,
-Tk will draw the polygon as a closed polygon.
+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.
-The following options are supported for polygons:
-.TP
-\fB\-fill \fIcolor\fR
-\fIColor\fR specifies a color to use for filling the area of the
-polygon; it may have any of the forms acceptable to \fBTk_GetColor\fR.
-If \fIcolor\fR is an empty string then the polygon will be
-transparent.
-This option defaults to \fBblack\fR.
+.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\-outline \fIcolor\fR
-\fIColor\fR specifies a color to use for drawing the polygon's
-outline; it may have any of the forms accepted by \fBTk_GetColor\fR.
-If \fIcolor\fR is an empty string then no outline will be
-drawn for the polygon.
-This option defaults to empty (no outline).
+\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
@@ -1323,25 +1509,6 @@ smoothed polygon by duplicating the end-points of the desired line segment.
Specifies the degree of smoothness desired for curves: each spline
will be approximated with \fInumber\fR line segments. This
option is ignored unless the \fB\-smooth\fR option is true.
-.TP
-\fB\-stipple \fIbitmap\fR
-Indicates that the polygon should be filled in a stipple pattern;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If \fIbitmap\fR is an empty string (the default), then filling is
-done in a solid fashion.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
-\fB\-width \fIoutlineWidth\fR
-\fIOutlineWidth\fR specifies the width of the outline to be drawn around
-the polygon, in any of the forms described in the COORDINATES section above.
-If the \fB\-outline\fR option hasn't been specified then this option
-has no effect. This option defaults to 1.0.
.PP
Polygon items are different from other items such as rectangles, ovals
and arcs in that interior points are considered to be ``inside'' a
@@ -1371,44 +1538,32 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for rectangles:
-.TP
-\fB\-fill \fIcolor\fR
-Fill the area of the rectangle with \fIcolor\fR, which may be
-specified in any of the forms accepted by \fBTk_GetColor\fR.
-If \fIcolor\fR is an empty string (the default),
-then the rectangle will not be filled.
-.TP
-\fB\-outline \fIcolor\fR
-Draw an outline around the edge of the rectangle in \fIcolor\fR.
-\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
-This option defaults to \fBblack\fR.
-If \fIcolor\fR is an empty string then no outline will be
-drawn for the rectangle.
-.TP
-\fB\-stipple \fIbitmap\fR
-Indicates that the rectangle should be filled in a stipple pattern;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If the \fB\-fill\fR option hasn't been specified then this option
-has no effect.
-If \fIbitmap\fR is an empty string (the default), then filling
-is done in a solid fashion.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
-\fB\-width \fIoutlineWidth\fR
-\fIOutlineWidth\fR specifies the width of the outline to be drawn around
-the rectangle, in any of the forms described in the COORDINATES section above.
-If the \fB\-outline\fR option hasn't been specified then this option
-has no effect.
-Wide outlines are drawn centered on the rectangular path
-defined by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR.
-This option defaults to 1.0.
+.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
@@ -1431,7 +1586,19 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for text items:
+.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
@@ -1443,12 +1610,6 @@ the top center point of the rectangular region occupied by the
text will be at the positioning point.
This option defaults to \fBcenter\fR.
.TP
-\fB\-fill \fIcolor\fR
-\fIColor\fR specifies a color to use for filling the text characters;
-it may have any of the forms accepted by \fBTk_GetColor\fR.
-If \fIcolor\fR is an empty string then the text will be transparent.
-If this option isn't specified then it defaults to \fBblack\fR.
-.TP
\fB\-font \fIfontName\fR
Specifies the font to use for the text item.
\fIFontName\fR may be any string acceptable to \fBTk_GetFontStruct\fR.
@@ -1463,20 +1624,6 @@ This option will only matter if the text is displayed as multiple
lines.
If the option is omitted, it defaults to \fBleft\fR.
.TP
-\fB\-stipple \fIbitmap\fR
-Indicates that the text should be drawn in a stippled pattern
-rather than solid;
-\fIbitmap\fR specifies the stipple pattern to use, in any of the
-forms accepted by \fBTk_GetBitmap\fR.
-If \fIbitmap\fR is an empty string (the default) then the text
-is drawn in a solid fashion.
-.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
\fB\-text \fIstring\fR
\fIString\fR specifies the characters to be displayed in the text item.
Newline characters cause line breaks.
@@ -1511,7 +1658,13 @@ pairs, each of which sets one of the configuration options
for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
used in \fBitemconfigure\fR widget commands to change the item's
configuration.
-The following options are supported for window items:
+.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
@@ -1529,12 +1682,6 @@ forms described in the COORDINATES section above.
If this option isn't specified, or if it is specified as an empty
string, then the window is given whatever height it requests internally.
.TP
-\fB\-tags \fItagList\fR
-Specifies a set of tags to apply to the item.
-\fITagList\fR consists of a list of tag names, which replace any
-existing tags for the item.
-\fITagList\fR may be an empty list.
-.TP
\fB\-width \fIpixels\fR
Specifies the width to assign to the item's window.
\fIPixels\fR may have any of the
@@ -1575,3 +1722,4 @@ functions of canvases.
.SH KEYWORDS
canvas, widget
+
diff --git a/tk/doc/checkbutton.n b/tk/doc/checkbutton.n
index 1867dbf52db..4e8a2c01319 100644
--- a/tk/doc/checkbutton.n
+++ b/tk/doc/checkbutton.n
@@ -236,3 +236,4 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
checkbutton, widget
+
diff --git a/tk/doc/chooseColor.n b/tk/doc/chooseColor.n
index 18b5feffe2f..6936030f169 100644
--- a/tk/doc/chooseColor.n
+++ b/tk/doc/chooseColor.n
@@ -47,3 +47,4 @@ button .b \-fg [tk_chooseColor \-initialcolor gray \-title "Choose color"]
.SH KEYWORDS
color selection dialog
+
diff --git a/tk/doc/chooseDirectory.n b/tk/doc/chooseDirectory.n
new file mode 100644
index 00000000000..0322b294ba8
--- /dev/null
+++ b/tk/doc/chooseDirectory.n
@@ -0,0 +1,53 @@
+'\"
+'\" 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/tk/doc/clipboard.n b/tk/doc/clipboard.n
index eea65467772..76a28d647fc 100644
--- a/tk/doc/clipboard.n
+++ b/tk/doc/clipboard.n
@@ -79,3 +79,4 @@ with a \fB\-\fR.
.SH KEYWORDS
clear, format, clipboard, append, selection, type
+
diff --git a/tk/doc/colors.n b/tk/doc/colors.n
new file mode 100644
index 00000000000..8b304fac72b
--- /dev/null
+++ b/tk/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 0
+blue violet 138 43 43
+blue1 0 0 0
+blue2 0 0 0
+blue3 0 0 0
+blue4 0 0 0
+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 0
+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 0
+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 0
+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 0
+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 0
+navy blue 0 0 0
+NavyBlue 0 0 0
+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/tk/doc/cursors.n b/tk/doc/cursors.n
new file mode 100644
index 00000000000..c93d3752597
--- /dev/null
+++ b/tk/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/tk/doc/destroy.n b/tk/doc/destroy.n
index f144ad86ebd..11c3cf8e70f 100644
--- a/tk/doc/destroy.n
+++ b/tk/doc/destroy.n
@@ -32,3 +32,4 @@ No error is returned if \fIwindow\fR does not exist.
.SH KEYWORDS
application, destroy, window
+
diff --git a/tk/doc/dialog.n b/tk/doc/dialog.n
index bd30e197b14..17665d21f30 100644
--- a/tk/doc/dialog.n
+++ b/tk/doc/dialog.n
@@ -63,3 +63,4 @@ in any way except to invoke the dialog box.
.SH KEYWORDS
bitmap, dialog, modal
+
diff --git a/tk/doc/entry.n b/tk/doc/entry.n
index c9ca3f0ff34..a62e551fc49 100644
--- a/tk/doc/entry.n
+++ b/tk/doc/entry.n
@@ -1,6 +1,7 @@
'\"
'\" 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.
@@ -8,7 +9,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH entry n 4.1 Tk "Tk Built-In Commands"
+.TH entry n 8.3 Tk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -24,6 +25,13 @@ entry \- Create and manipulate entry widgets
\-foreground \-insertofftime \-selectborderwidth
.SE
.SH "WIDGET-SPECIFIC OPTIONS"
+.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
.OP \-show show Show
If this option is specified, then the true contents of the entry
are not displayed in the window.
@@ -39,6 +47,21 @@ Specifies one of two states for the entry: \fBnormal\fR or \fBdisabled\fR.
If the entry is disabled then the value may not be changed using widget
commands and no insertion cursor will be displayed, even if the input focus is
in the widget.
+.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.
@@ -79,11 +102,85 @@ 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 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 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
+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?
@@ -259,6 +356,14 @@ 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
@@ -415,3 +520,5 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
entry, widget
+
+
diff --git a/tk/doc/event.n b/tk/doc/event.n
index 49633bfebb2..dc63b699126 100644
--- a/tk/doc/event.n
+++ b/tk/doc/event.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH event n 8.0 Tk "Tk Built-In Commands"
+.TH event n 8.3 Tk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -51,12 +51,14 @@ trigger anymore.
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
+.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.
@@ -107,7 +109,6 @@ for the event. Valid for \fBExpose\fR events.
Corresponds to the \fB%c\fR substitution for binding scripts.
.TP
\fB\-delta\fI number\fR
-.VS
\fINumber\fR must be an integer; it specifies the \fIdelta\fR field
for the \fBMouseWheel\fR event. The \fIdelta\fR refers to the
direction and magnitude the mouse wheel was rotated. Note the value
@@ -117,7 +118,6 @@ scroll the text widget up 4 lines and -240 would scroll the text
widget down 8 lines. Of course, other widgets may define different
behaviors for mouse wheel motion. This field corresponds to the
\fB%D\fR substitution for binding scripts.
-.VE
.TP
\fB\-detail\fI detail\fR
\fIDetail\fR specifies the \fIdetail\fR field for the event
@@ -239,6 +239,13 @@ Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\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.
@@ -273,6 +280,9 @@ Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\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
@@ -282,6 +292,9 @@ Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\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
@@ -350,3 +363,4 @@ bind
.SH KEYWORDS
event, binding, define, handle, virtual event
+
diff --git a/tk/doc/exit.n b/tk/doc/exit.n
new file mode 100644
index 00000000000..2dfffb4791c
--- /dev/null
+++ b/tk/doc/exit.n
@@ -0,0 +1,28 @@
+'\"
+'\" Copyright (c) 1993 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) exit.n 1.6 96/03/25 20:13:32
+'\"
+.so man.macros
+.TH exit n "" Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+exit \- End the application
+.SH SYNOPSIS
+\fBexit \fR?\fIreturnCode\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Terminate the process, returning \fIreturnCode\fR to the
+system as the exit status.
+If \fIreturnCode\fR isn't specified then it defaults
+to 0.
+
+.SH KEYWORDS
+exit, process
diff --git a/tk/doc/fileevent.n b/tk/doc/fileevent.n
new file mode 100644
index 00000000000..daff74eaa6b
--- /dev/null
+++ b/tk/doc/fileevent.n
@@ -0,0 +1,109 @@
+'\"
+'\" Copyright (c) 1994 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) fileevent.n 1.6 96/02/23 13:46:29
+'\"
+.so man.macros
+.TH fileevent n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+fileevent \- Execute a script when a channel becomes readable or writable
+.SH SYNOPSIS
+\fBfileevent \fIchannelId \fBreadable \fR?\fIscript\fR?
+.sp
+\fBfileevent \fIchannelId \fBwritable \fR?\fIscript\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is used to create \fIfile event handlers\fR. A file event
+handler is a binding between a channel and a script, such that the script
+is evaluated whenever the channel becomes readable or writable. File event
+handlers are most commonly used to allow data to be received from another
+process on an event-driven basis, so that the receiver can continue to
+interact with the user while waiting for the data to arrive. If an
+application invokes \fBgets\fR or \fBread\fR on a blocking channel when
+there is no input data available, the process will block; until the input
+data arrives, it will not be able to service other events, so it will
+appear to the user to ``freeze up''. With \fBfileevent\fR, the process can
+tell when data is present and only invoke \fBgets\fR or \fBread\fR when
+they won't block.
+.PP
+The \fIchannelId\fR argument to \fBfileevent\fR refers to an open channel,
+such as the return value from a previous \fBopen\fR or \fBsocket\fR
+command.
+If the \fIscript\fR argument is specified, then \fBfileevent\fR
+creates a new event handler: \fIscript\fR will be evaluated
+whenever the channel becomes readable or writable (depending on the
+second argument to \fBfileevent\fR).
+In this case \fBfileevent\fR returns an empty string.
+The \fBreadable\fR and \fBwritable\fR event handlers for a file
+are independent, and may be created and deleted separately.
+However, there may be at most one \fBreadable\fR and one \fBwritable\fR
+handler for a file at a given time in a given interpreter.
+If \fBfileevent\fR is called when the specified handler already
+exists in the invoking interpreter, the new script replaces the old one.
+.PP
+If the \fIscript\fR argument is not specified, \fBfileevent\fR
+returns the current script for \fIchannelId\fR, or an empty string
+if there is none.
+If the \fIscript\fR argument is specified as an empty string
+then the event handler is deleted, so that no script will be invoked.
+A file event handler is also deleted automatically whenever
+its channel is closed or its interpreter is deleted.
+.PP
+A channel is considered to be readable if there is unread data
+available on the underlying device.
+A channel is also considered to be readable if there is unread
+data in an input buffer, except in the special case where the
+most recent attempt to read from the channel was a \fBgets\fR
+call that could not find a complete line in the input buffer.
+This feature allows a file to be read a line at a time in nonblocking mode
+using events.
+A channel is also considered to be readable if an end of file or
+error condition is present on the underlying file or device.
+It is important for \fIscript\fR to check for these conditions
+and handle them appropriately; for example, if there is no special
+check for end of file, an infinite loop may occur where \fIscript\fR
+reads no data, returns, and is immediately invoked again.
+.PP
+A channel is considered to be writable if at least one byte of data
+can be written to the underlying file or device without blocking,
+or if an error condition is present on the underlying file or device.
+.PP
+Event-driven I/O works best for channels that have been
+placed into nonblocking mode with the \fBfconfigure\fR command.
+In blocking mode, a \fBputs\fR command may block if you give it
+more data than the underlying file or device can accept, and a
+\fBgets\fR or \fBread\fR command will block if you attempt to read
+more data than is ready; no events will be processed while the
+commands block.
+In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block.
+See the documentation for the individual commands for information
+on how they handle blocking and nonblocking channels.
+.PP
+The script for a file event is executed at global level (outside the
+context of any Tcl procedure) in the interpreter in which the
+\fBfileevent\fR command was invoked.
+If an error occurs while executing the script then the
+\fBbgerror\fR mechanism is used to report the error.
+In addition, the file event handler is deleted if it ever returns
+an error; this is done in order to prevent infinite loops due to
+buggy handlers.
+
+.SH CREDITS
+.PP
+\fBfileevent\fR is based on the \fBaddinput\fR command created
+by Mark Diekhans.
+
+.SH "SEE ALSO"
+bgerror, fconfigure, gets, puts, read
+
+.SH KEYWORDS
+asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
+script, writable.
diff --git a/tk/doc/focus.n b/tk/doc/focus.n
index 496563c943f..98015763b54 100644
--- a/tk/doc/focus.n
+++ b/tk/doc/focus.n
@@ -111,3 +111,4 @@ you use C code to query the X server directly.
.SH KEYWORDS
events, focus, keyboard, top-level, window manager
+
diff --git a/tk/doc/focusNext.n b/tk/doc/focusNext.n
index a98e0fc56ad..34d4be22d3e 100644
--- a/tk/doc/focusNext.n
+++ b/tk/doc/focusNext.n
@@ -58,3 +58,4 @@ to write a script that deletes the bindings created by
.SH KEYWORDS
focus, keyboard traversal, top-level
+
diff --git a/tk/doc/font.n b/tk/doc/font.n
index b7d4b94c340..8da646a986b 100644
--- a/tk/doc/font.n
+++ b/tk/doc/font.n
@@ -283,3 +283,4 @@ options
.SH KEYWORDS
font
+
diff --git a/tk/doc/frame.n b/tk/doc/frame.n
index 6d8bf9901f4..fb15271f5ae 100644
--- a/tk/doc/frame.n
+++ b/tk/doc/frame.n
@@ -132,3 +132,4 @@ frames are not intended to be interactive.
.SH KEYWORDS
frame, widget
+
diff --git a/tk/doc/getOpenFile.n b/tk/doc/getOpenFile.n
index 5c455214f16..88390e29fef 100644
--- a/tk/doc/getOpenFile.n
+++ b/tk/doc/getOpenFile.n
@@ -67,8 +67,18 @@ control panel on the Mac allows the end user to override the
application default directory.
.TP
\fB\-initialfile\fR \fIfilename\fR
-Specifies a filename to be displayed in the dialog when it pops
-up. This option is ignored by the \fBtk_getOpenFile\fR command.
+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.
+This is only available on the Macintosh, and only when Navigation
+Services are installed.
+.TP
+\fB\-message\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
@@ -76,8 +86,7 @@ dialog is displayed on top of its parent window.
.TP
\fB\-title\fR \fItitleString\fR
Specifies a string to display as the title of the dialog box. If this
-option is not specified, then a default title is displayed. This
-option is ignored on the Macintosh platform.
+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
@@ -153,5 +162,8 @@ if {$filename != ""} {
}
.CE
+.SH "SEE ALSO"
+tk_chooseDirectory
+
.SH KEYWORDS
file selection dialog
diff --git a/tk/doc/grab.n b/tk/doc/grab.n
index 2d261d9c723..e4038b94c8f 100644
--- a/tk/doc/grab.n
+++ b/tk/doc/grab.n
@@ -120,3 +120,4 @@ processes, this restriction doesn't exist.
.SH KEYWORDS
grab, keyboard events, pointer events, window
+
diff --git a/tk/doc/grid.n b/tk/doc/grid.n
index 517efa3cbc0..d4a8ac844dc 100644
--- a/tk/doc/grid.n
+++ b/tk/doc/grid.n
@@ -335,3 +335,4 @@ geometry manager written by Doug. Stein, and the \fBblt_table\fR geometry
manager, written by George Howlett.
.SH KEYWORDS
geometry manager, location, grid, cell, propagation, size, pack
+
diff --git a/tk/doc/image.n b/tk/doc/image.n
index e998293c52d..e03cc849c02 100644
--- a/tk/doc/image.n
+++ b/tk/doc/image.n
@@ -88,3 +88,4 @@ See the \fBphoto\fR manual entry for more information.
.SH KEYWORDS
height, image, types of images, width
+
diff --git a/tk/doc/keysyms.n b/tk/doc/keysyms.n
new file mode 100644
index 00000000000..0746d54357b
--- /dev/null
+++ b/tk/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/tk/doc/label.n b/tk/doc/label.n
index 4abc312bac4..0410d82d848 100644
--- a/tk/doc/label.n
+++ b/tk/doc/label.n
@@ -16,11 +16,14 @@ label \- Create and manipulate label widgets
.SH SYNOPSIS
\fBlabel\fR \fIpathName \fR?\fIoptions\fR?
.SO
-\-anchor \-font \-image \-takefocus
-\-background \-foreground \-justify \-text
-\-bitmap \-highlightbackground \-padx \-textvariable
-\-borderwidth \-highlightcolor \-pady \-underline
-\-cursor \-highlightthickness \-relief \-wraplength
+\-activebackground \-activeforeground \-anchor
+\-background \-bitmap \-borderwidth
+\-cursor \-disabledforeground \-font
+\-foreground \-highlightbackground \-highlightcolor
+\-highlightthickness \-image \-justify
+\-padx \-pady \-relief
+\-takefocus \-text \-textvariable
+\-underline \-wraplength
.SE
.SH "WIDGET-SPECIFIC OPTIONS"
.OP \-height height Height
@@ -30,6 +33,14 @@ 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
@@ -101,3 +112,5 @@ labels are not intended to be interactive.
.SH KEYWORDS
label, widget
+
+
diff --git a/tk/doc/listbox.n b/tk/doc/listbox.n
index 7610e3ad344..424e8d473d9 100644
--- a/tk/doc/listbox.n
+++ b/tk/doc/listbox.n
@@ -17,7 +17,7 @@ listbox \- Create and manipulate listbox widgets
\fBlistbox\fR \fIpathName \fR?\fIoptions\fR?
.SO
\-background \-foreground \-relief \-takefocus
-\-borderwidth \-height \-selectbackground \-width
+\-borderwidth \-height \-listvar \-selectbackground \-width
\-cursor \-highlightbackground \-selectborderwidth \-xscrollcommand
\-exportselection \-highlightcolor \-selectforeground \-yscrollcommand
\-font \-highlightthickness \-setgrid
@@ -27,6 +27,13 @@ listbox \- Create and manipulate listbox widgets
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 \-listvar 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 bad list value to a variable in use as a listvar
+will cause an error. Attempts to unset a variable in use as a listvar
+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
@@ -208,6 +215,44 @@ 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.
@@ -388,6 +433,10 @@ 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]
@@ -489,3 +538,4 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
listbox, widget
+
diff --git a/tk/doc/loadTk.n b/tk/doc/loadTk.n
index b34ce06868c..ef73f381937 100644
--- a/tk/doc/loadTk.n
+++ b/tk/doc/loadTk.n
@@ -74,3 +74,4 @@ safe(n), interp(n), library(n), load(n), package(n), source(n), unknown(n)
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source
+
diff --git a/tk/doc/lower.n b/tk/doc/lower.n
index 8738c23e465..c2c81b4d276 100644
--- a/tk/doc/lower.n
+++ b/tk/doc/lower.n
@@ -36,3 +36,4 @@ raise
.SH KEYWORDS
lower, obscure, stacking order
+
diff --git a/tk/doc/man.macros b/tk/doc/man.macros
index 6f3016f492f..ae66ef928af 100644
--- a/tk/doc/man.macros
+++ b/tk/doc/man.macros
@@ -72,8 +72,8 @@
. ie !"\\$2"" .TP \\n()Cu
. el .TP 15
.\}
-.ie !"\\$3"" \{\
.ta \\n()Au \\n()Bu
+.ie !"\\$3"" \{\
\&\\$1 \\fI\\$2\\fP (\\$3)
.\".b
.\}
diff --git a/tk/doc/menu.n b/tk/doc/menu.n
index d593ea2eef0..07a169c461d 100644
--- a/tk/doc/menu.n
+++ b/tk/doc/menu.n
@@ -236,6 +236,12 @@ 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
@@ -755,3 +761,5 @@ entries.
.SH KEYWORDS
menu, widget
+
+
diff --git a/tk/doc/menubar.n b/tk/doc/menubar.n
index 59fc252860e..a58dcb3f3e1 100644
--- a/tk/doc/menubar.n
+++ b/tk/doc/menubar.n
@@ -31,3 +31,4 @@ procedures will go away.
.SH KEYWORDS
keyboard traversal, menu, menu bar, post
+
diff --git a/tk/doc/menubutton.n b/tk/doc/menubutton.n
index da1a3291174..aaf166e0511 100644
--- a/tk/doc/menubutton.n
+++ b/tk/doc/menubutton.n
@@ -191,3 +191,4 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
menubutton, widget
+
diff --git a/tk/doc/message.n b/tk/doc/message.n
index a236741c419..8f4280e4185 100644
--- a/tk/doc/message.n
+++ b/tk/doc/message.n
@@ -145,3 +145,4 @@ The most common result is that the line is justified wrong.
.SH KEYWORDS
message, widget
+
diff --git a/tk/doc/messageBox.n b/tk/doc/messageBox.n
index 06df6e47aff..4bebf4481bc 100644
--- a/tk/doc/messageBox.n
+++ b/tk/doc/messageBox.n
@@ -37,7 +37,7 @@ option is not specified, there won't be any default button.
\fB\-icon\fR \fIiconImage\fR
Specifies an icon to display. \fIIconImage\fR must be one of the
following: \fBerror\fR, \fBinfo\fR, \fBquestion\fR or
-\fBwarning\fR. If this option is not specified, then no icon will be
+\fBwarning\fR. If this option is not specified, then the info icon will be
displayed.
.TP
\fB\-message\fR \fIstring\fR
@@ -80,7 +80,7 @@ and \fBcancel\fR.
.SH EXAMPLE
.CS
set answer [tk_messageBox \-message "Really quit?" \-type yesno \-icon question]
-case $answer {
+switch -- $answer {
yes exit
no {tk_messageBox \-message "I know you like this application!" \-type ok}
}
@@ -88,3 +88,4 @@ case $answer {
.SH KEYWORDS
message box
+
diff --git a/tk/doc/option.n b/tk/doc/option.n
index 8f0dd6ad5de..8e942a891f9 100644
--- a/tk/doc/option.n
+++ b/tk/doc/option.n
@@ -89,3 +89,4 @@ levels other than the ones given above.
.SH KEYWORDS
database, option, priority, retrieve
+
diff --git a/tk/doc/optionMenu.n b/tk/doc/optionMenu.n
index 9dd7147ed16..04f582bed09 100644
--- a/tk/doc/optionMenu.n
+++ b/tk/doc/optionMenu.n
@@ -38,3 +38,4 @@ options or manipulate it in other ways.
.SH KEYWORDS
option menu
+
diff --git a/tk/doc/options.n b/tk/doc/options.n
index 11f9ea78756..a556351e2a7 100644
--- a/tk/doc/options.n
+++ b/tk/doc/options.n
@@ -278,7 +278,8 @@ 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.
+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
@@ -326,3 +327,4 @@ on how this option is used.
.SH KEYWORDS
class, name, standard option, switch
+
diff --git a/tk/doc/pack-old.n b/tk/doc/pack-old.n
index 902fcc5970e..d31e1825963 100644
--- a/tk/doc/pack-old.n
+++ b/tk/doc/pack-old.n
@@ -194,3 +194,4 @@ such that zero space would be leftover for \fBexpand\fR options.
.SH KEYWORDS
geometry manager, location, packer, parcel, size
+
diff --git a/tk/doc/pack.n b/tk/doc/pack.n
index 1ead2ff4d9d..ff00682ac7d 100644
--- a/tk/doc/pack.n
+++ b/tk/doc/pack.n
@@ -264,3 +264,4 @@ the stacking order of either the master or the slave.
.SH KEYWORDS
geometry manager, location, packer, parcel, propagation, size
+
diff --git a/tk/doc/palette.n b/tk/doc/palette.n
index a0a3433e362..d340dd943d3 100644
--- a/tk/doc/palette.n
+++ b/tk/doc/palette.n
@@ -71,3 +71,4 @@ color scheme used in Tk 3.6 and earlier versions.
.SH KEYWORDS
bisque, color, palette
+
diff --git a/tk/doc/photo.n b/tk/doc/photo.n
index bb0391a9eda..ddc491bd72a 100644
--- a/tk/doc/photo.n
+++ b/tk/doc/photo.n
@@ -24,7 +24,7 @@ photo \- Full-color images
.SH DESCRIPTION
.PP
A photo is an image whose pixels can display any color or be
-transparent. A photo image is stored internally in full color (24
+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
@@ -40,7 +40,8 @@ command.
Photos support the following \fIoptions\fR:
.TP
\fB\-data \fIstring\fR
-Specifies the contents of the image as a string. The format of the
+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
@@ -186,25 +187,78 @@ about the Y or X axes, respectively. If \fIy\fR is not given, the
default value is the same as \fIx\fR.
.RE
.TP
+\fIimageName \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 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
+.TP
\fIimageName \fBget\fR \fIx y\fR
Returns the color of the pixel at coordinates (\fIx\fR,\fIy\fR) in the
image as a list of three integers between 0 and 255, representing the
red, green and blue components respectively.
.TP
-\fIimageName \fBput \fIdata\fR ?\fB\-to\fI x1 y1 x2 y2\fR?
-Sets pixels in \fIimageName\fR to the colors specified in \fIdata\fR.
-\fIdata\fR is used to form a two-dimensional array of pixels that are
-then copied into the \fIimageName\fR. \fIdata\fR is structured as a
-list of horizontal rows, from top to bottom, each of which is a list
-of colors, listed from left to right. Each color may be specified by name
-(e.g., blue) or in hexadecimal form (e.g., #2376af). The
-\fB\-to\fR option can be used to specify the area of \fIimageName\fR to be
-affected. If only \fIx1\fR and \fIy1\fR are given, the area affected
-has its top-left corner at (\fIx1,y1\fR) and is the same size as the
-array given in \fIdata\fR. If all four coordinates are given, they
-specify diagonally opposite corners of the affected rectangle, and the
-array given in \fIdata\fR will be replicated as necessary in the X and
-Y directions to fill the rectangle.
+\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.
@@ -258,6 +312,11 @@ 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
@@ -273,7 +332,12 @@ 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
+.TP
.SH "IMAGE FORMATS"
.PP
The photo image code is structured to allow handlers for additional
@@ -342,3 +406,4 @@ John Ousterhout.
.SH KEYWORDS
photo, image, color
+
diff --git a/tk/doc/place.n b/tk/doc/place.n
index 040962a7e58..aaddaba37dd 100644
--- a/tk/doc/place.n
+++ b/tk/doc/place.n
@@ -235,3 +235,4 @@ frames and canvases that provide configuration options for this purpose.
.SH KEYWORDS
geometry manager, height, location, master, place, rubber sheet, slave, width
+
diff --git a/tk/doc/popup.n b/tk/doc/popup.n
index 8f574c85ead..6103ac34f46 100644
--- a/tk/doc/popup.n
+++ b/tk/doc/popup.n
@@ -31,3 +31,4 @@ the given point.
.SH KEYWORDS
menu, popup
+
diff --git a/tk/doc/radiobutton.n b/tk/doc/radiobutton.n
index 7b32b8dc62d..977cb703bd8 100644
--- a/tk/doc/radiobutton.n
+++ b/tk/doc/radiobutton.n
@@ -231,3 +231,4 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
radiobutton, widget
+
diff --git a/tk/doc/raise.n b/tk/doc/raise.n
index 550e0914eba..aedab0b021b 100644
--- a/tk/doc/raise.n
+++ b/tk/doc/raise.n
@@ -36,3 +36,4 @@ lower
.SH KEYWORDS
obscure, raise, stacking order
+
diff --git a/tk/doc/scale.n b/tk/doc/scale.n
index 720971a97bc..6daaa142923 100644
--- a/tk/doc/scale.n
+++ b/tk/doc/scale.n
@@ -244,3 +244,4 @@ individual widgets or by redefining the class bindings.
.SH KEYWORDS
scale, slider, trough, widget
+
diff --git a/tk/doc/scrollbar.n b/tk/doc/scrollbar.n
index 73cc0b767d8..a52cf95ce80 100644
--- a/tk/doc/scrollbar.n
+++ b/tk/doc/scrollbar.n
@@ -338,3 +338,4 @@ The End key adjusts the view to the bottom (right edge) of the document.
.SH KEYWORDS
scrollbar, widget
+
diff --git a/tk/doc/selection.n b/tk/doc/selection.n
index e25af000fac..72feff07328 100644
--- a/tk/doc/selection.n
+++ b/tk/doc/selection.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH selection n 4.0 Tk "Tk Built-In Commands"
+.TH selection n 8.1 Tk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -70,19 +70,21 @@ and \fItype\fR is the requested type, \fIcommand\fR will be executed
as a Tcl command with two additional numbers appended to it
(with space separators).
The two additional numbers
-are \fIoffset\fR and \fImaxBytes\fR: \fIoffset\fR specifies a starting
-character position in the selection and \fImaxBytes\fR gives the maximum
-number of bytes to retrieve. The command should return a value consisting
-of at most \fImaxBytes\fR of the selection, starting at position
-\fIoffset\fR. For very large selections (larger than \fImaxBytes\fR)
+.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 \fImaxBytes\fR, the return value is assumed to
+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 \fImaxBytes\fR then
+\fIcommand\fR's result is equal to \fImaxChars\fR then
\fIcommand\fR will be invoked again, until it eventually
-returns a result shorter than \fImaxBytes\fR. The value of \fImaxBytes\fR
-will always be relatively large (thousands of bytes).
+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.
@@ -126,3 +128,4 @@ some other window claims ownership of the selection away from
.SH KEYWORDS
clear, format, handler, ICCCM, own, selection, target, type
+
diff --git a/tk/doc/send.n b/tk/doc/send.n
index 410eec6fcab..4e35474f512 100644
--- a/tk/doc/send.n
+++ b/tk/doc/send.n
@@ -70,8 +70,8 @@ command.
.SH SECURITY
.PP
-The \fBsend\fR command is potentially a serious security loophole,
-since any application that can connect to your X server can send
+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.
@@ -87,6 +87,12 @@ 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
-application, name, remote execution, security, send
+.VS
+application, dde, name, remote execution, security, send
+.VE
+
diff --git a/tk/doc/text.n b/tk/doc/text.n
index 9e310f13a3b..5a0892d76fc 100644
--- a/tk/doc/text.n
+++ b/tk/doc/text.n
@@ -324,6 +324,11 @@ 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
@@ -501,8 +506,8 @@ If a mark has left gravity, then the mark is treated as if it
were attached to the character on its left, so the mark will
remain to the left of any text inserted at the mark position.
If the mark has right gravity, new text inserted at the mark
-position will appear to the right of the mark. The gravity
-for a mark defaults to \fBright\fR.
+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
@@ -820,7 +825,7 @@ One or more of the following switches (or abbreviations thereof)
may be specified to control the dump:
.TP
\fB\-all\fR
-Return information about all elements: text, marks, tags, and windows.
+Return information about all elements: text, marks, tags, images and windows.
This is the default.
.TP
\fB\-command \fIcommand\fR
@@ -829,13 +834,16 @@ 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.
+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
@@ -1052,8 +1060,15 @@ Ignore case differences between the pattern and the text.
.TP
\fB\-count\fI varName\fR
The argument following \fB\-count\fR gives the name of a variable;
-if a match is found, the number of characters in the matching
-range will be stored in the variable.
+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:
@@ -1430,9 +1445,8 @@ This command used to be used for scrolling, but now it is obsolete.
.PP
Tk automatically creates class bindings for texts that give them
the following default behavior.
-In the descriptions below, ``word'' refers to a contiguous group
-of letters, digits, or ``_'' characters, or any single character
-other than these.
+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
@@ -1619,3 +1633,4 @@ cursor blinks, which causes a steady stream of graphics traffic.
Set the \fBinsertOffTime\fP attribute to 0 avoid this.
.SH KEYWORDS
text, widget
+
diff --git a/tk/doc/tk.n b/tk/doc/tk.n
index b31533ae0c9..590ca6d5f4b 100644
--- a/tk/doc/tk.n
+++ b/tk/doc/tk.n
@@ -8,7 +8,7 @@
'\" RCS: @(#) $Id$
'\"
.so man.macros
-.TH tk n 4.0 Tk "Tk Built-In Commands"
+.TH tk n 8.3 Tk "Tk Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -43,7 +43,6 @@ be able to find some options for the application.
If sends have been disabled by deleting the \fBsend\fR command,
this command will reenable them and recreate the \fBsend\fR
command.
-.VS
.TP
\fBtk scaling \fR?\fB\-displayof \fIwindow\fR? ?\fInumber\fR?
.
@@ -67,6 +66,18 @@ 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.
.VE
.SH KEYWORDS
application name, send
+
diff --git a/tk/doc/tkerror.n b/tk/doc/tkerror.n
index 9ccee96b1bc..115eb033f89 100644
--- a/tk/doc/tkerror.n
+++ b/tk/doc/tkerror.n
@@ -36,3 +36,4 @@ documentation.
.SH KEYWORDS
background error, reporting
+
diff --git a/tk/doc/tkvars.n b/tk/doc/tkvars.n
index 22d2c292e0b..652fc77b866 100644
--- a/tk/doc/tkvars.n
+++ b/tk/doc/tkvars.n
@@ -70,3 +70,4 @@ major version number changes.
.SH KEYWORDS
variables, version
+
diff --git a/tk/doc/tkwait.n b/tk/doc/tkwait.n
index 0c39f384975..e5da82a0beb 100644
--- a/tk/doc/tkwait.n
+++ b/tk/doc/tkwait.n
@@ -49,3 +49,4 @@ to \fBtkwait\fR must complete before the outer call can complete.
.SH KEYWORDS
variable, visibility, wait, window
+
diff --git a/tk/doc/toplevel.n b/tk/doc/toplevel.n
index 9b980300d85..c8e7fc43a3e 100644
--- a/tk/doc/toplevel.n
+++ b/tk/doc/toplevel.n
@@ -161,3 +161,4 @@ toplevels are not intended to be interactive.
.SH KEYWORDS
toplevel, widget
+
diff --git a/tk/doc/update.n b/tk/doc/update.n
new file mode 100644
index 00000000000..522b1766d4c
--- /dev/null
+++ b/tk/doc/update.n
@@ -0,0 +1,48 @@
+'\"
+'\" Copyright (c) 1990-1992 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: @(#) update.n 1.3 96/03/25 20:26:34
+'\"
+.so man.macros
+.TH update n 7.5 Tcl "Tcl Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+update \- Process pending events and idle callbacks
+.SH SYNOPSIS
+\fBupdate\fR ?\fBidletasks\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is used to bring the application ``up to date''
+by entering the event loop repeated until all pending events
+(including idle callbacks) have been processed.
+.PP
+If the \fBidletasks\fR keyword is specified as an argument to the
+command, then no new events or errors are processed; only idle
+callbacks are invoked.
+This causes operations that are normally deferred, such as display
+updates and window layout calculations, to be performed immediately.
+.PP
+The \fBupdate idletasks\fR command is useful in scripts where
+changes have been made to the application's state and you want those
+changes to appear on the display immediately, rather than waiting
+for the script to complete. Most display updates are performed as
+idle callbacks, so \fBupdate idletasks\fR will cause them to run.
+However, there are some kinds of updates that only happen in
+response to events, such as those triggered by window size changes;
+these updates will not occur in \fBupdate idletasks\fR.
+.PP
+The \fBupdate\fR command with no options is useful in scripts where
+you are performing a long-running computation but you still want
+the application to respond to events such as user interactions; if
+you occasionally call \fBupdate\fR then user input will be processed
+during the next call to \fBupdate\fR.
+
+.SH KEYWORDS
+event, flush, handler, idle, update
diff --git a/tk/doc/winfo.n b/tk/doc/winfo.n
index 5272c09adb6..e8cae44aabb 100644
--- a/tk/doc/winfo.n
+++ b/tk/doc/winfo.n
@@ -328,3 +328,4 @@ has no border).
.SH KEYWORDS
atom, children, class, geometry, height, identifier, information, interpreters,
mapped, parent, path name, screen, virtual root, width, window
+
diff --git a/tk/doc/wish.1 b/tk/doc/wish.1
index 4afc2be5dff..157729f01c0 100644
--- a/tk/doc/wish.1
+++ b/tk/doc/wish.1
@@ -184,3 +184,4 @@ incomplete commands.
.SH KEYWORDS
shell, toolkit
+
diff --git a/tk/doc/wm.n b/tk/doc/wm.n
index 6fc6f7c16e1..6d146bb4a6b 100644
--- a/tk/doc/wm.n
+++ b/tk/doc/wm.n
@@ -99,7 +99,9 @@ Arrange for \fIwindow\fR to be displayed in normal (non-iconified) form.
This is done by mapping the window. If the window has never been
mapped then this command will not map the window, but it will ensure
that when the window is first mapped it will be displayed
-in de-iconified form. Returns an empty string.
+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
@@ -317,7 +319,7 @@ window at the given place without asking the user for assistance.
If \fIwho\fR is specified as an empty string, then the current position
source is cancelled.
If \fIwho\fR is specified, then the command returns an empty string.
-Otherwise it returns \fBuser\fR or \fBwindow\fR to indicate the
+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.
@@ -389,14 +391,15 @@ source of the window's current size, or an empty string if
no source has been specified yet. Most window managers interpret
``no source'' as equivalent to \fBprogram\fR.
.TP
-\fBwm state \fIwindow\fR
-Returns the current state of \fIwindow\fR: either \fBnormal\fR,
-\fBiconic\fR, \fBwithdrawn\fR, or \fBicon\fR. The difference
-between \fBiconic\fR and \fBicon\fR is that \fBiconic\fR refers
-to a window that has been iconified (e.g., with the \fBwm iconify\fR
-command) while \fBicon\fR refers to a window whose only purpose is
-to serve as the icon for some other window (via the \fBwm iconwindow\fR
-command).
+\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
@@ -501,3 +504,4 @@ to be withdrawn and de-iconified in order to make the change happen.
.SH KEYWORDS
aspect ratio, deiconify, focus model, geometry, grid, group, icon, iconify, increments, position, size, title, top-level window, units, window manager
+
diff --git a/tk/generic/default.h b/tk/generic/default.h
index 1315608f33a..8db5f297b58 100644
--- a/tk/generic/default.h
+++ b/tk/generic/default.h
@@ -16,7 +16,8 @@
#ifndef _DEFAULT
#define _DEFAULT
-#if defined(__WIN32__) || defined(_WIN32)
+#if defined(__WIN32__) || defined(_WIN32) || \
+ defined(__CYGWIN__) || defined(__MINGW32__)
# include "tkWinDefault.h"
#else
# if defined(MAC_TCL)
@@ -27,3 +28,4 @@
#endif
#endif /* _DEFAULT */
+
diff --git a/tk/generic/ks_names.h b/tk/generic/ks_names.h
index 759becc7b06..7c299e8b5f6 100644
--- a/tk/generic/ks_names.h
+++ b/tk/generic/ks_names.h
@@ -8,6 +8,8 @@
{ "Clear", 0xFF0B },
{ "Return", 0xFF0D },
{ "Pause", 0xFF13 },
+{ "Scroll_Lock", 0xFF14 },
+{ "Sys_Req", 0xFF15 },
{ "Escape", 0xFF1B },
{ "Delete", 0xFFFF },
{ "Multi_key", 0xFF20 },
@@ -919,3 +921,5 @@
{ "hebrew_shin", 0xcf9 },
{ "hebrew_taf", 0xcfa },
{ "Hebrew_switch", 0xFF7E },
+
+
diff --git a/tk/generic/patchlevel.h b/tk/generic/patchlevel.h
new file mode 100644
index 00000000000..8053233c2bf
--- /dev/null
+++ b/tk/generic/patchlevel.h
@@ -0,0 +1,23 @@
+/*
+ * patchlevel.h --
+ *
+ * This file does nothing except define a "patch level" for Tk.
+ * The patch level has the form "X.YpZ" where X.Y is the base
+ * release, and Z is a serial number that is used to sequence
+ * patches for a given release. Thus 4.0p1 is the first patch
+ * to release 4.0, 4.0p2 is the patch that follows 4.0p1, and
+ * so on. The "pZ" is omitted in an original new release, and
+ * it is replaced with "bZ" for beta releases or "aZ" for alpha
+ * releases (e.g. 4.0b1 is the first beta release of Tk 4.0).
+ * The patch level ensures that patches are applied in the
+ * correct order and only to appropriate sources.
+ *
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) patchlevel.h 1.16 96/04/10 14:30:23
+ */
+
+#define TK_PATCH_LEVEL "4.1"
diff --git a/tk/generic/prolog.ps b/tk/generic/prolog.ps
new file mode 100644
index 00000000000..2ab137266ef
--- /dev/null
+++ b/tk/generic/prolog.ps
@@ -0,0 +1,285 @@
+%%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/tk/generic/tk.decls b/tk/generic/tk.decls
new file mode 100644
index 00000000000..51679e2ad3d
--- /dev/null
+++ b/tk/generic/tk.decls
@@ -0,0 +1,1215 @@
+# tk.decls --
+#
+# This file contains the declarations for all supported public
+# functions that are exported by the Tk library via the stubs table.
+# This file is used to generate the tkDecls.h, tkPlatDecls.h,
+# tkStub.c, and tkPlatStub.c files.
+#
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id$
+
+library tk
+
+# Define the tk interface with 3 sub interfaces:
+# tkPlat - platform specific public
+# tkInt - generic private
+# tkPlatInt - platform specific private
+
+interface tk
+hooks {tkPlat tkInt tkIntPlat tkIntXlib}
+
+# Declare each of the functions in the public Tk interface. Note that
+# the an index should never be reused for a different function in order
+# to preserve backwards compatibility.
+
+declare 0 generic {
+ void Tk_MainLoop (void)
+}
+
+declare 1 generic {
+ XColor *Tk_3DBorderColor (Tk_3DBorder border)
+}
+
+declare 2 generic {
+ GC Tk_3DBorderGC (Tk_Window tkwin, Tk_3DBorder border, \
+ int which)
+}
+
+declare 3 generic {
+ void Tk_3DHorizontalBevel (Tk_Window tkwin, \
+ Drawable drawable, Tk_3DBorder border, int x, \
+ int y, int width, int height, int leftIn, \
+ int rightIn, int topBevel, int relief)
+}
+
+declare 4 generic {
+ void Tk_3DVerticalBevel (Tk_Window tkwin, \
+ Drawable drawable, Tk_3DBorder border, int x, \
+ int y, int width, int height, int leftBevel, \
+ int relief)
+}
+
+declare 5 generic {
+ void Tk_AddOption (Tk_Window tkwin, char *name, \
+ char *value, int priority)
+}
+
+declare 6 generic {
+ void Tk_BindEvent (Tk_BindingTable bindingTable, \
+ XEvent *eventPtr, Tk_Window tkwin, int numObjects, \
+ ClientData *objectPtr)
+}
+
+declare 7 generic {
+ void Tk_CanvasDrawableCoords (Tk_Canvas canvas, \
+ double x, double y, short *drawableXPtr, \
+ short *drawableYPtr)
+}
+
+declare 8 generic {
+ void Tk_CanvasEventuallyRedraw (Tk_Canvas canvas, int x1, int y1, \
+ int x2, int y2)
+}
+
+declare 9 generic {
+ int Tk_CanvasGetCoord (Tcl_Interp *interp, \
+ Tk_Canvas canvas, char *str, double *doublePtr)
+}
+
+declare 10 generic {
+ Tk_CanvasTextInfo *Tk_CanvasGetTextInfo (Tk_Canvas canvas)
+}
+
+declare 11 generic {
+ int Tk_CanvasPsBitmap (Tcl_Interp *interp, \
+ Tk_Canvas canvas, Pixmap bitmap, int x, int y, \
+ int width, int height)
+}
+
+declare 12 generic {
+ int Tk_CanvasPsColor (Tcl_Interp *interp, \
+ Tk_Canvas canvas, XColor *colorPtr)
+}
+
+declare 13 generic {
+ int Tk_CanvasPsFont (Tcl_Interp *interp, \
+ Tk_Canvas canvas, Tk_Font font)
+}
+
+declare 14 generic {
+ void Tk_CanvasPsPath (Tcl_Interp *interp, \
+ Tk_Canvas canvas, double *coordPtr, int numPoints)
+}
+
+declare 15 generic {
+ int Tk_CanvasPsStipple (Tcl_Interp *interp, \
+ Tk_Canvas canvas, Pixmap bitmap)
+}
+
+declare 16 generic {
+ double Tk_CanvasPsY (Tk_Canvas canvas, double y)
+}
+
+declare 17 generic {
+ void Tk_CanvasSetStippleOrigin (Tk_Canvas canvas, GC gc)
+}
+
+declare 18 generic {
+ int Tk_CanvasTagsParseProc (ClientData clientData, Tcl_Interp *interp, \
+ Tk_Window tkwin, char *value, char *widgRec, int offset)
+}
+
+declare 19 generic {
+ char * Tk_CanvasTagsPrintProc (ClientData clientData, Tk_Window tkwin, \
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+}
+
+declare 20 generic {
+ Tk_Window Tk_CanvasTkwin (Tk_Canvas canvas)
+}
+
+declare 21 generic {
+ void Tk_CanvasWindowCoords (Tk_Canvas canvas, double x, double y, \
+ short *screenXPtr, short *screenYPtr)
+}
+
+declare 22 generic {
+ void Tk_ChangeWindowAttributes (Tk_Window tkwin, unsigned long valueMask, \
+ XSetWindowAttributes *attsPtr)
+}
+
+declare 23 generic {
+ int Tk_CharBbox (Tk_TextLayout layout, int index, int *xPtr, \
+ int *yPtr, int *widthPtr, int *heightPtr)
+}
+
+declare 24 generic {
+ void Tk_ClearSelection (Tk_Window tkwin, Atom selection)
+}
+
+declare 25 generic {
+ int Tk_ClipboardAppend (Tcl_Interp *interp,Tk_Window tkwin, \
+ Atom target, Atom format, char* buffer)
+}
+
+declare 26 generic {
+ int Tk_ClipboardClear (Tcl_Interp *interp, Tk_Window tkwin)
+}
+
+declare 27 generic {
+ int Tk_ConfigureInfo (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tk_ConfigSpec *specs, \
+ char *widgRec, char *argvName, int flags)
+}
+
+declare 28 generic {
+ int Tk_ConfigureValue (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tk_ConfigSpec *specs, \
+ char *widgRec, char *argvName, int flags)
+}
+
+declare 29 generic {
+ int Tk_ConfigureWidget (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tk_ConfigSpec *specs, \
+ int argc, char **argv, char *widgRec, \
+ int flags)
+}
+
+declare 30 generic {
+ void Tk_ConfigureWindow (Tk_Window tkwin, \
+ unsigned int valueMask, XWindowChanges *valuePtr)
+}
+
+declare 31 generic {
+ Tk_TextLayout Tk_ComputeTextLayout (Tk_Font font, \
+ CONST char *str, int numChars, int wrapLength, \
+ Tk_Justify justify, int flags, int *widthPtr, \
+ int *heightPtr)
+}
+
+declare 32 generic {
+ Tk_Window Tk_CoordsToWindow (int rootX, int rootY, Tk_Window tkwin)
+}
+
+declare 33 generic {
+ unsigned long Tk_CreateBinding (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable, ClientData object, \
+ char *eventStr, char *command, int append)
+}
+
+declare 34 generic {
+ Tk_BindingTable Tk_CreateBindingTable (Tcl_Interp *interp)
+}
+
+declare 35 generic {
+ Tk_ErrorHandler Tk_CreateErrorHandler (Display *display, \
+ int errNum, int request, int minorCode, \
+ Tk_ErrorProc *errorProc, ClientData clientData)
+}
+
+declare 36 generic {
+ void Tk_CreateEventHandler (Tk_Window token, \
+ unsigned long mask, Tk_EventProc *proc, \
+ ClientData clientData)
+}
+
+declare 37 generic {
+ void Tk_CreateGenericHandler (Tk_GenericProc *proc, ClientData clientData)
+}
+
+declare 38 generic {
+ void Tk_CreateImageType (Tk_ImageType *typePtr)
+}
+
+declare 39 generic {
+ void Tk_CreateItemType (Tk_ItemType *typePtr)
+}
+
+declare 40 generic {
+ void Tk_CreatePhotoImageFormat (Tk_PhotoImageFormat *formatPtr)
+}
+
+declare 41 generic {
+ void Tk_CreateSelHandler (Tk_Window tkwin, \
+ Atom selection, Atom target, \
+ Tk_SelectionProc *proc, ClientData clientData, \
+ Atom format)
+}
+
+declare 42 generic {
+ Tk_Window Tk_CreateWindow (Tcl_Interp *interp, \
+ Tk_Window parent, char *name, char *screenName)
+}
+
+declare 43 generic {
+ Tk_Window Tk_CreateWindowFromPath (Tcl_Interp *interp, Tk_Window tkwin, \
+ char *pathName, char *screenName)
+}
+
+declare 44 generic {
+ int Tk_DefineBitmap (Tcl_Interp *interp, CONST char *name, char *source, \
+ int width, int height)
+}
+
+declare 45 generic {
+ void Tk_DefineCursor (Tk_Window window, Tk_Cursor cursor)
+}
+
+declare 46 generic {
+ void Tk_DeleteAllBindings (Tk_BindingTable bindingTable, ClientData object)
+}
+
+declare 47 generic {
+ int Tk_DeleteBinding (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable, ClientData object, \
+ char *eventStr)
+}
+
+declare 48 generic {
+ void Tk_DeleteBindingTable (Tk_BindingTable bindingTable)
+}
+
+declare 49 generic {
+ void Tk_DeleteErrorHandler (Tk_ErrorHandler handler)
+}
+
+declare 50 generic {
+ void Tk_DeleteEventHandler (Tk_Window token, \
+ unsigned long mask, Tk_EventProc *proc, \
+ ClientData clientData)
+}
+
+declare 51 generic {
+ void Tk_DeleteGenericHandler (Tk_GenericProc *proc, ClientData clientData)
+}
+
+declare 52 generic {
+ void Tk_DeleteImage (Tcl_Interp *interp, char *name)
+}
+
+declare 53 generic {
+ void Tk_DeleteSelHandler (Tk_Window tkwin, Atom selection, Atom target)
+}
+
+declare 54 generic {
+ void Tk_DestroyWindow (Tk_Window tkwin)
+}
+
+declare 55 generic {
+ char * Tk_DisplayName (Tk_Window tkwin)
+}
+
+declare 56 generic {
+ int Tk_DistanceToTextLayout (Tk_TextLayout layout, int x, int y)
+}
+
+declare 57 generic {
+ void Tk_Draw3DPolygon (Tk_Window tkwin, \
+ Drawable drawable, Tk_3DBorder border, \
+ XPoint *pointPtr, int numPoints, int borderWidth, \
+ int leftRelief)
+}
+
+declare 58 generic {
+ void Tk_Draw3DRectangle (Tk_Window tkwin, Drawable drawable, \
+ Tk_3DBorder border, int x, int y, int width, int height, \
+ int borderWidth, int relief)
+}
+
+declare 59 generic {
+ void Tk_DrawChars (Display *display, Drawable drawable, GC gc, \
+ Tk_Font tkfont, CONST char *source, int numBytes, int x, int y)
+}
+
+declare 60 generic {
+ void Tk_DrawFocusHighlight (Tk_Window tkwin, GC gc, int width, \
+ Drawable drawable)
+}
+
+declare 61 generic {
+ void Tk_DrawTextLayout (Display *display, \
+ Drawable drawable, GC gc, Tk_TextLayout layout, \
+ int x, int y, int firstChar, int lastChar)
+}
+
+declare 62 generic {
+ void Tk_Fill3DPolygon (Tk_Window tkwin, \
+ Drawable drawable, Tk_3DBorder border, \
+ XPoint *pointPtr, int numPoints, int borderWidth, \
+ int leftRelief)
+}
+
+declare 63 generic {
+ void Tk_Fill3DRectangle (Tk_Window tkwin, \
+ Drawable drawable, Tk_3DBorder border, int x, \
+ int y, int width, int height, int borderWidth, \
+ int relief)
+}
+
+declare 64 generic {
+ Tk_PhotoHandle Tk_FindPhoto (Tcl_Interp *interp, char *imageName)
+}
+
+declare 65 generic {
+ Font Tk_FontId (Tk_Font font)
+}
+
+declare 66 generic {
+ void Tk_Free3DBorder (Tk_3DBorder border)
+}
+
+declare 67 generic {
+ void Tk_FreeBitmap (Display *display, Pixmap bitmap)
+}
+
+declare 68 generic {
+ void Tk_FreeColor (XColor *colorPtr)
+}
+
+declare 69 generic {
+ void Tk_FreeColormap (Display *display, Colormap colormap)
+}
+
+declare 70 generic {
+ void Tk_FreeCursor (Display *display, Tk_Cursor cursor)
+}
+
+declare 71 generic {
+ void Tk_FreeFont (Tk_Font f)
+}
+
+declare 72 generic {
+ void Tk_FreeGC (Display *display, GC gc)
+}
+
+declare 73 generic {
+ void Tk_FreeImage (Tk_Image image)
+}
+
+declare 74 generic {
+ void Tk_FreeOptions (Tk_ConfigSpec *specs, \
+ char *widgRec, Display *display, int needFlags)
+}
+
+declare 75 generic {
+ void Tk_FreePixmap (Display *display, Pixmap pixmap)
+}
+
+declare 76 generic {
+ void Tk_FreeTextLayout (Tk_TextLayout textLayout)
+}
+
+declare 77 generic {
+ void Tk_FreeXId (Display *display, XID xid)
+}
+
+declare 78 generic {
+ GC Tk_GCForColor (XColor *colorPtr, Drawable drawable)
+}
+
+declare 79 generic {
+ void Tk_GeometryRequest (Tk_Window tkwin, int reqWidth, int reqHeight)
+}
+
+declare 80 generic {
+ Tk_3DBorder Tk_Get3DBorder (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tk_Uid colorName)
+}
+
+declare 81 generic {
+ void Tk_GetAllBindings (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable, ClientData object)
+}
+
+declare 82 generic {
+ int Tk_GetAnchor (Tcl_Interp *interp, \
+ char *str, Tk_Anchor *anchorPtr)
+}
+
+declare 83 generic {
+ char * Tk_GetAtomName (Tk_Window tkwin, Atom atom)
+}
+
+declare 84 generic {
+ char * Tk_GetBinding (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable, ClientData object, \
+ char *eventStr)
+}
+
+declare 85 generic {
+ Pixmap Tk_GetBitmap (Tcl_Interp *interp, Tk_Window tkwin, CONST char * str)
+}
+
+declare 86 generic {
+ Pixmap Tk_GetBitmapFromData (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *source, int width, int height)
+}
+
+declare 87 generic {
+ int Tk_GetCapStyle (Tcl_Interp *interp, char *str, int *capPtr)
+}
+
+declare 88 generic {
+ XColor * Tk_GetColor (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid name)
+}
+
+declare 89 generic {
+ XColor * Tk_GetColorByValue (Tk_Window tkwin, XColor *colorPtr)
+}
+
+declare 90 generic {
+ Colormap Tk_GetColormap (Tcl_Interp *interp, Tk_Window tkwin, char *str)
+}
+
+declare 91 generic {
+ Tk_Cursor Tk_GetCursor (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tk_Uid str)
+}
+
+declare 92 generic {
+ Tk_Cursor Tk_GetCursorFromData (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *source, char *mask, \
+ int width, int height, int xHot, int yHot, \
+ Tk_Uid fg, Tk_Uid bg)
+}
+
+declare 93 generic {
+ Tk_Font Tk_GetFont (Tcl_Interp *interp, \
+ Tk_Window tkwin, CONST char *str)
+}
+
+declare 94 generic {
+ Tk_Font Tk_GetFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 95 generic {
+ void Tk_GetFontMetrics (Tk_Font font, Tk_FontMetrics *fmPtr)
+}
+
+declare 96 generic {
+ GC Tk_GetGC (Tk_Window tkwin, unsigned long valueMask, XGCValues *valuePtr)
+}
+
+declare 97 generic {
+ Tk_Image Tk_GetImage (Tcl_Interp *interp, Tk_Window tkwin, char *name, \
+ Tk_ImageChangedProc *changeProc, ClientData clientData)
+}
+
+declare 98 generic {
+ ClientData Tk_GetImageMasterData (Tcl_Interp *interp, \
+ char *name, Tk_ImageType **typePtrPtr)
+}
+
+declare 99 generic {
+ Tk_ItemType * Tk_GetItemTypes (void)
+}
+
+declare 100 generic {
+ int Tk_GetJoinStyle (Tcl_Interp *interp, char *str, int *joinPtr)
+}
+
+declare 101 generic {
+ int Tk_GetJustify (Tcl_Interp *interp, \
+ char *str, Tk_Justify *justifyPtr)
+}
+
+declare 102 generic {
+ int Tk_GetNumMainWindows (void)
+}
+
+declare 103 generic {
+ Tk_Uid Tk_GetOption (Tk_Window tkwin, char *name, char *className)
+}
+
+declare 104 generic {
+ int Tk_GetPixels (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *str, int *intPtr)
+}
+
+declare 105 generic {
+ Pixmap Tk_GetPixmap (Display *display, Drawable d, \
+ int width, int height, int depth)
+}
+
+declare 106 generic {
+ int Tk_GetRelief (Tcl_Interp *interp, char *name, int *reliefPtr)
+}
+
+declare 107 generic {
+ void Tk_GetRootCoords (Tk_Window tkwin, int *xPtr, int *yPtr)
+}
+
+declare 108 generic {
+ int Tk_GetScrollInfo (Tcl_Interp *interp, \
+ int argc, char **argv, double *dblPtr, int *intPtr)
+}
+
+declare 109 generic {
+ int Tk_GetScreenMM (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *str, double *doublePtr)
+}
+
+declare 110 generic {
+ int Tk_GetSelection (Tcl_Interp *interp, \
+ Tk_Window tkwin, Atom selection, Atom target, \
+ Tk_GetSelProc *proc, ClientData clientData)
+}
+
+declare 111 generic {
+ Tk_Uid Tk_GetUid (CONST char *str)
+}
+
+declare 112 generic {
+ Visual * Tk_GetVisual (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *str, int *depthPtr, \
+ Colormap *colormapPtr)
+}
+
+declare 113 generic {
+ void Tk_GetVRootGeometry (Tk_Window tkwin, \
+ int *xPtr, int *yPtr, int *widthPtr, int *heightPtr)
+}
+
+declare 114 generic {
+ int Tk_Grab (Tcl_Interp *interp, Tk_Window tkwin, int grabGlobal)
+}
+
+declare 115 generic {
+ void Tk_HandleEvent (XEvent *eventPtr)
+}
+
+declare 116 generic {
+ Tk_Window Tk_IdToWindow (Display *display, Window window)
+}
+
+declare 117 generic {
+ void Tk_ImageChanged (Tk_ImageMaster master, int x, int y, \
+ int width, int height, int imageWidth, int imageHeight)
+}
+
+declare 118 generic {
+ int Tk_Init (Tcl_Interp *interp)
+}
+
+declare 119 generic {
+ Atom Tk_InternAtom (Tk_Window tkwin, char *name)
+}
+
+declare 120 generic {
+ int Tk_IntersectTextLayout (Tk_TextLayout layout, int x, int y, \
+ int width, int height)
+}
+
+declare 121 generic {
+ void Tk_MaintainGeometry (Tk_Window slave, \
+ Tk_Window master, int x, int y, int width, int height)
+}
+
+declare 122 generic {
+ Tk_Window Tk_MainWindow (Tcl_Interp *interp)
+}
+
+declare 123 generic {
+ void Tk_MakeWindowExist (Tk_Window tkwin)
+}
+
+declare 124 generic {
+ void Tk_ManageGeometry (Tk_Window tkwin, \
+ Tk_GeomMgr *mgrPtr, ClientData clientData)
+}
+
+declare 125 generic {
+ void Tk_MapWindow (Tk_Window tkwin)
+}
+
+declare 126 generic {
+ int Tk_MeasureChars (Tk_Font tkfont, \
+ CONST char *source, int numBytes, int maxPixels, \
+ int flags, int *lengthPtr)
+}
+
+declare 127 generic {
+ void Tk_MoveResizeWindow (Tk_Window tkwin, \
+ int x, int y, int width, int height)
+}
+
+declare 128 generic {
+ void Tk_MoveWindow (Tk_Window tkwin, int x, int y)
+}
+
+declare 129 generic {
+ void Tk_MoveToplevelWindow (Tk_Window tkwin, int x, int y)
+}
+
+declare 130 generic {
+ char * Tk_NameOf3DBorder (Tk_3DBorder border)
+}
+
+declare 131 generic {
+ char * Tk_NameOfAnchor (Tk_Anchor anchor)
+}
+
+declare 132 generic {
+ char * Tk_NameOfBitmap (Display *display, Pixmap bitmap)
+}
+
+declare 133 generic {
+ char * Tk_NameOfCapStyle (int cap)
+}
+
+declare 134 generic {
+ char * Tk_NameOfColor (XColor *colorPtr)
+}
+
+declare 135 generic {
+ char * Tk_NameOfCursor (Display *display, Tk_Cursor cursor)
+}
+
+declare 136 generic {
+ char * Tk_NameOfFont (Tk_Font font)
+}
+
+declare 137 generic {
+ char * Tk_NameOfImage (Tk_ImageMaster imageMaster)
+}
+
+declare 138 generic {
+ char * Tk_NameOfJoinStyle (int join)
+}
+
+declare 139 generic {
+ char * Tk_NameOfJustify (Tk_Justify justify)
+}
+
+declare 140 generic {
+ char * Tk_NameOfRelief (int relief)
+}
+
+declare 141 generic {
+ Tk_Window Tk_NameToWindow (Tcl_Interp *interp, \
+ char *pathName, Tk_Window tkwin)
+}
+
+declare 142 generic {
+ void Tk_OwnSelection (Tk_Window tkwin, \
+ Atom selection, Tk_LostSelProc *proc, \
+ ClientData clientData)
+}
+
+declare 143 generic {
+ int Tk_ParseArgv (Tcl_Interp *interp, \
+ Tk_Window tkwin, int *argcPtr, char **argv, \
+ Tk_ArgvInfo *argTable, int flags)
+}
+
+declare 144 generic {
+ void Tk_PhotoPutBlock (Tk_PhotoHandle handle, \
+ Tk_PhotoImageBlock *blockPtr, int x, int y, \
+ int width, int height)
+}
+
+declare 145 generic {
+ void Tk_PhotoPutZoomedBlock (Tk_PhotoHandle handle, \
+ Tk_PhotoImageBlock *blockPtr, int x, int y, \
+ int width, int height, int zoomX, int zoomY, \
+ int subsampleX, int subsampleY)
+}
+
+declare 146 generic {
+ int Tk_PhotoGetImage (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr)
+}
+
+declare 147 generic {
+ void Tk_PhotoBlank (Tk_PhotoHandle handle)
+}
+
+declare 148 generic {
+ void Tk_PhotoExpand (Tk_PhotoHandle handle, int width, int height )
+}
+
+declare 149 generic {
+ void Tk_PhotoGetSize (Tk_PhotoHandle handle, int *widthPtr, int *heightPtr)
+}
+
+declare 150 generic {
+ void Tk_PhotoSetSize (Tk_PhotoHandle handle, int width, int height)
+}
+
+declare 151 generic {
+ int Tk_PointToChar (Tk_TextLayout layout, int x, int y)
+}
+
+declare 152 generic {
+ int Tk_PostscriptFontName (Tk_Font tkfont, Tcl_DString *dsPtr)
+}
+
+declare 153 generic {
+ void Tk_PreserveColormap (Display *display, Colormap colormap)
+}
+
+declare 154 generic {
+ void Tk_QueueWindowEvent (XEvent *eventPtr, Tcl_QueuePosition position)
+}
+
+declare 155 generic {
+ void Tk_RedrawImage (Tk_Image image, int imageX, \
+ int imageY, int width, int height, \
+ Drawable drawable, int drawableX, int drawableY)
+}
+
+declare 156 generic {
+ void Tk_ResizeWindow (Tk_Window tkwin, int width, int height)
+}
+
+declare 157 generic {
+ int Tk_RestackWindow (Tk_Window tkwin, int aboveBelow, Tk_Window other)
+}
+
+declare 158 generic {
+ Tk_RestrictProc *Tk_RestrictEvents (Tk_RestrictProc *proc, \
+ ClientData arg, ClientData *prevArgPtr)
+}
+
+declare 159 generic {
+ int Tk_SafeInit (Tcl_Interp *interp)
+}
+
+declare 160 generic {
+ char * Tk_SetAppName (Tk_Window tkwin, char *name)
+}
+
+declare 161 generic {
+ void Tk_SetBackgroundFromBorder (Tk_Window tkwin, Tk_3DBorder border)
+}
+
+declare 162 generic {
+ void Tk_SetClass (Tk_Window tkwin, char *className)
+}
+
+declare 163 generic {
+ void Tk_SetGrid (Tk_Window tkwin, int reqWidth, int reqHeight, \
+ int gridWidth, int gridHeight)
+}
+
+declare 164 generic {
+ void Tk_SetInternalBorder (Tk_Window tkwin, int width)
+}
+
+declare 165 generic {
+ void Tk_SetWindowBackground (Tk_Window tkwin, unsigned long pixel)
+}
+
+declare 166 generic {
+ void Tk_SetWindowBackgroundPixmap (Tk_Window tkwin, Pixmap pixmap)
+}
+
+declare 167 generic {
+ void Tk_SetWindowBorder (Tk_Window tkwin, unsigned long pixel)
+}
+
+declare 168 generic {
+ void Tk_SetWindowBorderWidth (Tk_Window tkwin, int width)
+}
+
+declare 169 generic {
+ void Tk_SetWindowBorderPixmap (Tk_Window tkwin, Pixmap pixmap)
+}
+
+declare 170 generic {
+ void Tk_SetWindowColormap (Tk_Window tkwin, Colormap colormap)
+}
+
+declare 171 generic {
+ int Tk_SetWindowVisual (Tk_Window tkwin, Visual *visual, int depth,\
+ Colormap colormap)
+}
+
+declare 172 generic {
+ void Tk_SizeOfBitmap (Display *display, Pixmap bitmap, int *widthPtr, \
+ int *heightPtr)
+}
+
+declare 173 generic {
+ void Tk_SizeOfImage (Tk_Image image, int *widthPtr, int *heightPtr)
+}
+
+declare 174 generic {
+ int Tk_StrictMotif (Tk_Window tkwin)
+}
+
+declare 175 generic {
+ void Tk_TextLayoutToPostscript (Tcl_Interp *interp, Tk_TextLayout layout)
+}
+
+declare 176 generic {
+ int Tk_TextWidth (Tk_Font font, CONST char *str, int numBytes)
+}
+
+declare 177 generic {
+ void Tk_UndefineCursor (Tk_Window window)
+}
+
+declare 178 generic {
+ void Tk_UnderlineChars (Display *display, \
+ Drawable drawable, GC gc, Tk_Font tkfont, \
+ CONST char *source, int x, int y, int firstByte, \
+ int lastByte)
+}
+
+declare 179 generic {
+ void Tk_UnderlineTextLayout (Display *display, Drawable drawable, GC gc, \
+ Tk_TextLayout layout, int x, int y, \
+ int underline)
+}
+
+declare 180 generic {
+ void Tk_Ungrab (Tk_Window tkwin)
+}
+
+declare 181 generic {
+ void Tk_UnmaintainGeometry (Tk_Window slave, Tk_Window master)
+}
+
+declare 182 generic {
+ void Tk_UnmapWindow (Tk_Window tkwin)
+}
+
+declare 183 generic {
+ void Tk_UnsetGrid (Tk_Window tkwin)
+}
+
+declare 184 generic {
+ void Tk_UpdatePointer (Tk_Window tkwin, int x, int y, int state)
+}
+
+# new functions for 8.1
+
+declare 185 generic {
+ Pixmap Tk_AllocBitmapFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tcl_Obj *objPtr)
+}
+
+declare 186 generic {
+ Tk_3DBorder Tk_Alloc3DBorderFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tcl_Obj *objPtr)
+}
+
+declare 187 generic {
+ XColor * Tk_AllocColorFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tcl_Obj *objPtr)
+}
+
+declare 188 generic {
+ Tk_Cursor Tk_AllocCursorFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tcl_Obj *objPtr)
+}
+
+declare 189 generic {
+ Tk_Font Tk_AllocFontFromObj (Tcl_Interp *interp, Tk_Window tkwin, \
+ Tcl_Obj *objPtr)
+
+}
+
+declare 190 generic {
+ Tk_OptionTable Tk_CreateOptionTable (Tcl_Interp *interp, \
+ CONST Tk_OptionSpec *templatePtr)
+}
+
+declare 191 generic {
+ void Tk_DeleteOptionTable (Tk_OptionTable optionTable)
+}
+
+declare 192 generic {
+ void Tk_Free3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 193 generic {
+ void Tk_FreeBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 194 generic {
+ void Tk_FreeColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 195 generic {
+ void Tk_FreeConfigOptions (char *recordPtr, Tk_OptionTable optionToken, \
+ Tk_Window tkwin)
+
+}
+
+declare 196 generic {
+ void Tk_FreeSavedOptions (Tk_SavedOptions *savePtr)
+}
+
+declare 197 generic {
+ void Tk_FreeCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 198 generic {
+ void Tk_FreeFontFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 199 generic {
+ Tk_3DBorder Tk_Get3DBorderFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 200 generic {
+ int Tk_GetAnchorFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, \
+ Tk_Anchor *anchorPtr)
+}
+
+declare 201 generic {
+ Pixmap Tk_GetBitmapFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 202 generic {
+ XColor * Tk_GetColorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 203 generic {
+ Tk_Cursor Tk_GetCursorFromObj (Tk_Window tkwin, Tcl_Obj *objPtr)
+}
+
+declare 204 generic {
+ Tcl_Obj * Tk_GetOptionInfo (Tcl_Interp *interp, \
+ char *recordPtr, Tk_OptionTable optionTable, \
+ Tcl_Obj *namePtr, Tk_Window tkwin)
+}
+
+declare 205 generic {
+ Tcl_Obj * Tk_GetOptionValue (Tcl_Interp *interp, char *recordPtr, \
+ Tk_OptionTable optionTable, Tcl_Obj *namePtr, Tk_Window tkwin)
+}
+
+declare 206 generic {
+ int Tk_GetJustifyFromObj (Tcl_Interp *interp, \
+ Tcl_Obj *objPtr, Tk_Justify *justifyPtr)
+}
+
+declare 207 generic {
+ int Tk_GetMMFromObj (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tcl_Obj *objPtr, double *doublePtr)
+}
+
+declare 208 generic {
+ int Tk_GetPixelsFromObj (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tcl_Obj *objPtr, int *intPtr)
+}
+
+declare 209 generic {
+ int Tk_GetReliefFromObj (Tcl_Interp *interp, \
+ Tcl_Obj *objPtr, int *resultPtr)
+}
+
+declare 210 generic {
+ int Tk_GetScrollInfoObj (Tcl_Interp *interp, \
+ int objc, Tcl_Obj *CONST objv[], double *dblPtr, int *intPtr)
+}
+
+declare 211 generic {
+ int Tk_InitOptions (
+ Tcl_Interp *interp, char *recordPtr, \
+ Tk_OptionTable optionToken, Tk_Window tkwin)
+}
+
+declare 212 generic {
+ void Tk_MainEx (int argc, char **argv, Tcl_AppInitProc *appInitProc, \
+ Tcl_Interp *interp)
+}
+
+declare 213 generic {
+ void Tk_RestoreSavedOptions (Tk_SavedOptions *savePtr)
+}
+
+declare 214 generic {
+ int Tk_SetOptions (Tcl_Interp *interp, char *recordPtr, \
+ Tk_OptionTable optionTable, int objc, \
+ Tcl_Obj *CONST objv[], Tk_Window tkwin, \
+ Tk_SavedOptions *savePtr, int *maskPtr)
+}
+
+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)
+}
+
+# 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)
+}
+
diff --git a/tk/generic/tk.h b/tk/generic/tk.h
index 5d1a05603dc..c4eb7145d56 100644
--- a/tk/generic/tk.h
+++ b/tk/generic/tk.h
@@ -6,8 +6,8 @@
*
* Copyright (c) 1989-1994 The Regents of the University of California.
* Copyright (c) 1994 The Australian National University.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * 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.
@@ -19,41 +19,39 @@
#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:
*
- * README
- * unix/configure.in
- * win/makefile.bc (Not for patch release updates)
- * win/makefile.vc (Not for patch release updates)
- * win/README
- * library/tk.tcl
- *
- * The release level should be 0 for alpha, 1 for beta, and 2 for
- * final/patch. The release serial value is the number that follows the
- * "a", "b", or "p" in the patch level; for example, if the patch level
- * is 4.3b2, TK_RELEASE_SERIAL is 2. It restarts at 1 whenever the
- * release level is changed, except for the final release, which should
- * be 0.
+ * 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/aclocal.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 0
-#define TK_RELEASE_LEVEL 2
-#define TK_RELEASE_SERIAL 4
-
-#define TK_VERSION "8.0"
-#define TK_PATCH_LEVEL "8.0.4"
+#define TK_MINOR_VERSION 3
+#define TK_RELEASE_LEVEL TCL_FINAL_RELEASE
+#define TK_RELEASE_SERIAL 2
-/*
- * A special definition used to allow this header file to be included
- * in resource files.
- */
-
-#ifndef RESOURCE_INCLUDED
+#define TK_VERSION "8.3"
+#define TK_PATCH_LEVEL "8.3.2"
/*
* The following definitions set up the proper options for Macintosh
@@ -69,6 +67,14 @@
#ifndef _TCL
# include <tcl.h>
#endif
+
+/*
+ * A special definition used to allow this header file to be included
+ * in resource files.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
#ifndef _XLIB_H
# ifdef MAC_TCL
# include <Xlib.h>
@@ -105,6 +111,8 @@ 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;
@@ -116,56 +124,167 @@ typedef struct Tk_3DBorder_ *Tk_3DBorder;
typedef char *Tk_Uid;
/*
- * Structure used to specify how to handle argv options.
+ * The enum below defines the valid types for Tk configuration options
+ * as implemented by Tk_InitOptions, Tk_SetOptions, etc.
*/
-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;
+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,
+/* CYGNUS LOCAL: Support -version argument. */
+ TK_OPTION_VERSION,
+ TK_OPTION_END
+} Tk_OptionType;
/*
- * Legal values for the type field of a Tk_ArgvInfo: see the user
- * documentation for details.
+ * 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.
*/
-#define TK_ARGV_CONSTANT 15
-#define TK_ARGV_INT 16
-#define TK_ARGV_STRING 17
-#define TK_ARGV_UID 18
-#define TK_ARGV_REST 19
-#define TK_ARGV_FLOAT 20
-#define TK_ARGV_FUNC 21
-#define TK_ARGV_GENFUNC 22
-#define TK_ARGV_HELP 23
-#define TK_ARGV_CONST_OPTION 24
-#define TK_ARGV_OPTION_VALUE 25
-#define TK_ARGV_OPTION_NAME_VALUE 26
-/* CYGNUS LOCAL: Support -version argument. */
-#define TK_ARGV_VERSION 27
-#define TK_ARGV_END 28
+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 bits for passing to Tk_ParseArgv:
+ * Flag values for Tk_OptionSpec structures. These flags are shared by
+ * Tk_ConfigSpec structures, so be sure to coordinate any changes
+ * carefully.
*/
-#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
+#define TK_OPTION_NULL_OK 1
+#define TK_OPTION_DONT_SET_DEFAULT 8
+
+/*
+ * 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.
+ * to return a text string describing an option. THESE ARE
+ * DEPRECATED; PLEASE USE THE NEW STRUCTURES LISTED ABOVE.
+ */
+
+/*
+ * This is a temporary flag used while tkObjConfig and new widgets
+ * are in development.
*/
+#ifndef __NO_OLD_CONFIG
+
typedef int (Tk_OptionParseProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tk_Window tkwin, char *value, char *widgRec,
int offset));
@@ -219,60 +338,82 @@ typedef struct Tk_ConfigSpec {
* documentation for details.
*/
-#define TK_CONFIG_BOOLEAN 1
-#define TK_CONFIG_INT 2
-#define TK_CONFIG_DOUBLE 3
-#define TK_CONFIG_STRING 4
-#define TK_CONFIG_UID 5
-#define TK_CONFIG_COLOR 6
-#define TK_CONFIG_FONT 7
-#define TK_CONFIG_BITMAP 8
-#define TK_CONFIG_BORDER 9
-#define TK_CONFIG_RELIEF 10
-#define TK_CONFIG_CURSOR 11
-#define TK_CONFIG_ACTIVE_CURSOR 12
-#define TK_CONFIG_JUSTIFY 13
-#define TK_CONFIG_ANCHOR 14
-#define TK_CONFIG_SYNONYM 15
-#define TK_CONFIG_CAP_STYLE 16
-#define TK_CONFIG_JOIN_STYLE 17
-#define TK_CONFIG_PIXELS 18
-#define TK_CONFIG_MM 19
-#define TK_CONFIG_WINDOW 20
-#define TK_CONFIG_CUSTOM 21
-#define TK_CONFIG_END 22
-
-/*
- * Macro to use to fill in "offset" fields of Tk_ConfigInfos.
- * Computes number of bytes from beginning of structure to a
- * given field.
- */
-
-#ifdef offsetof
-#define Tk_Offset(type, field) ((int) offsetof(type, field))
-#else
-#define Tk_Offset(type, field) ((int) ((char *) &((type *) 0)->field))
-#endif
+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_ConfigInfo structures. Any bits at
+ * 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
- * tkConfig.c (internal-use-only flags are defined there).
+ * tkOldConfig.c (internal-use-only flags are defined there).
*/
-#define TK_CONFIG_COLOR_ONLY 1
-#define TK_CONFIG_MONO_ONLY 2
-#define TK_CONFIG_NULL_OK 4
+#define TK_CONFIG_NULL_OK 1
+#define TK_CONFIG_COLOR_ONLY 2
+#define TK_CONFIG_MONO_ONLY 4
#define TK_CONFIG_DONT_SET_DEFAULT 8
#define TK_CONFIG_OPTION_SPECIFIED 0x10
#define TK_CONFIG_USER_BIT 0x100
+#endif /* __NO_OLD_CONFIG */
+
+/*
+ * Structure used to specify how to handle argv options.
+ */
+
+typedef struct {
+ char *key; /* The key string that flags the option in the
+ * argv array. */
+ int type; /* Indicates option type; see below. */
+ char *src; /* Value to be used in setting dst; usage
+ * depends on type. */
+ char *dst; /* Address of value to be modified; usage
+ * depends on type. */
+ char *help; /* Documentation message describing this option. */
+} Tk_ArgvInfo;
+
+/*
+ * Legal values for the type field of a Tk_ArgvInfo: see the user
+ * documentation for details.
+ */
+
+#define TK_ARGV_CONSTANT 15
+#define TK_ARGV_INT 16
+#define TK_ARGV_STRING 17
+#define TK_ARGV_UID 18
+#define TK_ARGV_REST 19
+#define TK_ARGV_FLOAT 20
+#define TK_ARGV_FUNC 21
+#define TK_ARGV_GENFUNC 22
+#define TK_ARGV_HELP 23
+#define TK_ARGV_CONST_OPTION 24
+#define TK_ARGV_OPTION_VALUE 25
+#define TK_ARGV_OPTION_NAME_VALUE 26
+/* CYGNUS LOCAL: Support -version argument. */
+#define TK_ARGV_VERSION 27
+#define TK_ARGV_END 28
+
+/*
+ * Flag bits for passing to Tk_ParseArgv:
+ */
+
+#define TK_ARGV_NO_DEFAULTS 0x1
+#define TK_ARGV_NO_LEFTOVERS 0x2
+#define TK_ARGV_NO_ABBREV 0x4
+#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8
/*
* Enumerated type for describing actions to be taken in response
@@ -297,12 +438,12 @@ typedef enum {
* Relief values returned by Tk_GetRelief:
*/
-#define TK_RELIEF_RAISED 1
-#define TK_RELIEF_FLAT 2
-#define TK_RELIEF_SUNKEN 4
-#define TK_RELIEF_GROOVE 8
-#define TK_RELIEF_RIDGE 16
-#define TK_RELIEF_SOLID 32
+#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:
@@ -638,6 +779,21 @@ typedef struct Tk_FakeWin {
*--------------------------------------------------------------
*/
+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
@@ -677,9 +833,9 @@ typedef struct Tk_Item {
* items in this canvas. Later items
* in list are drawn just below earlier
* ones. */
- int reserved1; /* This padding is for compatibility */
- char *reserved2; /* with Jan Nijtmans dash patch */
- int reserved3;
+ Tk_State state; /* state of item */
+ char *reserved1; /* reserved for future use */
+ int redraw_flags; /* some flags used in the canvas */
/*
*------------------------------------------------------------------
@@ -692,11 +848,25 @@ typedef struct Tk_Item {
} 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));
@@ -706,6 +876,17 @@ typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp,
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,
@@ -735,6 +916,8 @@ typedef void Tk_ItemInsertProc _ANSI_ARGS_((Tk_Canvas canvas,
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". */
@@ -755,7 +938,7 @@ typedef struct Tk_ItemType {
* this type. */
int alwaysRedraw; /* Non-zero means displayProc should
* be called even when the item has
- * been moved off-screen. */
+ * been moved off-screen. */
Tk_ItemPointProc *pointProc; /* Computes distance from item to
* a given point. */
Tk_ItemAreaProc *areaProc; /* Computes whether item is inside,
@@ -788,6 +971,8 @@ typedef struct Tk_ItemType {
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
@@ -806,16 +991,17 @@ typedef struct Tk_CanvasTextInfo {
Tk_Item *selItemPtr; /* Pointer to selected item. NULL means
* selection isn't in this canvas.
* Writable by items. */
- int selectFirst; /* Index of first selected character.
- * Writable by items. */
- int selectLast; /* Index of last selected character.
- * Writable by items. */
+ 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; /* Fixed end of selection (i.e. "select to"
- * operation will use this as one end of the
- * selection). Writable by 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
@@ -833,6 +1019,59 @@ typedef struct Tk_CanvasTextInfo {
} 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:
@@ -841,9 +1080,15 @@ typedef struct Tk_CanvasTextInfo {
*/
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,
@@ -855,6 +1100,9 @@ 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
@@ -884,6 +1132,9 @@ struct Tk_ImageType {
* 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
@@ -918,10 +1169,9 @@ typedef struct Tk_PhotoImageBlock {
* pixels in successive lines. */
int pixelSize; /* Address difference between successive
* pixels in the same line. */
- int offset[3]; /* Address differences between the red, green
- * and blue components of the pixel and the
- * pixel as a whole. */
- int reserved; /* Reserved for extensions (dash patch) */
+ int offset[4]; /* Address differences between the red, green,
+ * blue and alpha components of the pixel and
+ * the pixel as a whole. */
} Tk_PhotoImageBlock;
/*
@@ -930,6 +1180,7 @@ typedef struct Tk_PhotoImageBlock {
*/
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_((Tcl_Obj *dataObj,
@@ -946,6 +1197,25 @@ typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
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
@@ -980,6 +1250,17 @@ struct Tk_PhotoImageFormat {
* 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
+
/*
*--------------------------------------------------------------
@@ -1018,11 +1299,35 @@ struct Tk_PhotoImageFormat {
#define Tk_DoWhenIdle Tcl_DoWhenIdle
#define Tk_Sleep Tcl_Sleep
+/* Additional stuff that has moved to Tcl: */
+
+#define Tk_AfterCmd Tcl_AfterCmd
#define Tk_EventuallyFree Tcl_EventuallyFree
#define Tk_FreeProc Tcl_FreeProc
#define Tk_Preserve Tcl_Preserve
#define Tk_Release Tcl_Release
-#define Tk_FileeventCmd Tcl_FileEventCmd
+
+/* Removed Tk_Main, use macro instead */
+#define Tk_Main(argc, argv, proc) \
+ Tk_MainEx(argc, argv, proc, Tcl_CreateInterp())
+
+char *Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version, int exact));
+
+#ifndef USE_TK_STUBS
+
+#define Tk_InitStubs(interp, version, exact) \
+ Tcl_PkgRequire(interp, "Tk", version, exact)
+
+#endif
+
+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
+
/*
*--------------------------------------------------------------
@@ -1046,6 +1351,7 @@ typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_((
typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
int offset, char *buffer, int maxBytes));
+
/*
*--------------------------------------------------------------
*
@@ -1054,512 +1360,26 @@ typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
*--------------------------------------------------------------
*/
-EXTERN XColor * Tk_3DBorderColor _ANSI_ARGS_((Tk_3DBorder border));
-EXTERN GC Tk_3DBorderGC _ANSI_ARGS_((Tk_Window tkwin,
- Tk_3DBorder border, int which));
-EXTERN void Tk_3DHorizontalBevel _ANSI_ARGS_((Tk_Window tkwin,
- Drawable drawable, Tk_3DBorder border, int x,
- int y, int width, int height, int leftIn,
- int rightIn, int topBevel, int relief));
-EXTERN void Tk_3DVerticalBevel _ANSI_ARGS_((Tk_Window tkwin,
- Drawable drawable, Tk_3DBorder border, int x,
- int y, int width, int height, int leftBevel,
- int relief));
-EXTERN void Tk_AddOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
- char *value, int priority));
-EXTERN void Tk_BindEvent _ANSI_ARGS_((Tk_BindingTable bindingTable,
- XEvent *eventPtr, Tk_Window tkwin, int numObjects,
- ClientData *objectPtr));
-EXTERN void Tk_CanvasDrawableCoords _ANSI_ARGS_((Tk_Canvas canvas,
- double x, double y, short *drawableXPtr,
- short *drawableYPtr));
-EXTERN void Tk_CanvasEventuallyRedraw _ANSI_ARGS_((
- Tk_Canvas canvas, int x1, int y1, int x2,
- int y2));
-EXTERN int Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, char *string,
- double *doublePtr));
-EXTERN Tk_CanvasTextInfo *Tk_CanvasGetTextInfo _ANSI_ARGS_((Tk_Canvas canvas));
-EXTERN int Tk_CanvasPsBitmap _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, Pixmap bitmap, int x, int y,
- int width, int height));
-EXTERN int Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, XColor *colorPtr));
-EXTERN int Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, Tk_Font font));
-EXTERN void Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, double *coordPtr, int numPoints));
-EXTERN int Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, Pixmap bitmap));
-EXTERN double Tk_CanvasPsY _ANSI_ARGS_((Tk_Canvas canvas, double y));
-EXTERN void Tk_CanvasSetStippleOrigin _ANSI_ARGS_((
- Tk_Canvas canvas, GC gc));
-EXTERN int Tk_CanvasTagsParseProc _ANSI_ARGS_((
- ClientData clientData, Tcl_Interp *interp,
- Tk_Window tkwin, char *value, char *widgRec,
- int offset));
-EXTERN char * Tk_CanvasTagsPrintProc _ANSI_ARGS_((
- ClientData clientData, Tk_Window tkwin,
- char *widgRec, int offset,
- Tcl_FreeProc **freeProcPtr));
-EXTERN Tk_Window Tk_CanvasTkwin _ANSI_ARGS_((Tk_Canvas canvas));
-EXTERN void Tk_CanvasWindowCoords _ANSI_ARGS_((Tk_Canvas canvas,
- double x, double y, short *screenXPtr,
- short *screenYPtr));
-EXTERN void Tk_ChangeWindowAttributes _ANSI_ARGS_((Tk_Window tkwin,
- unsigned long valueMask,
- XSetWindowAttributes *attsPtr));
-EXTERN int Tk_CharBbox _ANSI_ARGS_((Tk_TextLayout layout,
- int index, int *xPtr, int *yPtr, int *widthPtr,
- int *heightPtr));
-EXTERN void Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin,
- Atom selection));
-EXTERN int Tk_ClipboardAppend _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Atom target, Atom format,
- char* buffer));
-EXTERN int Tk_ClipboardClear _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin));
-EXTERN int Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_ConfigSpec *specs,
- char *widgRec, char *argvName, int flags));
-EXTERN int Tk_ConfigureValue _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_ConfigSpec *specs,
- char *widgRec, char *argvName, int flags));
-EXTERN int Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_ConfigSpec *specs,
- int argc, char **argv, char *widgRec,
- int flags));
-EXTERN void Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin,
- unsigned int valueMask, XWindowChanges *valuePtr));
-EXTERN Tk_TextLayout Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font,
- CONST char *string, int numChars, int wrapLength,
- Tk_Justify justify, int flags, int *widthPtr,
- int *heightPtr));
-EXTERN Tk_Window Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY,
- Tk_Window tkwin));
-EXTERN unsigned long Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_BindingTable bindingTable, ClientData object,
- char *eventString, char *command, int append));
-EXTERN Tk_BindingTable Tk_CreateBindingTable _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Tk_ErrorHandler Tk_CreateErrorHandler _ANSI_ARGS_((Display *display,
- int errNum, int request, int minorCode,
- Tk_ErrorProc *errorProc, ClientData clientData));
-EXTERN void Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token,
- unsigned long mask, Tk_EventProc *proc,
- ClientData clientData));
-EXTERN void Tk_CreateGenericHandler _ANSI_ARGS_((
- Tk_GenericProc *proc, ClientData clientData));
-EXTERN void Tk_CreateImageType _ANSI_ARGS_((
- Tk_ImageType *typePtr));
-EXTERN void Tk_CreateItemType _ANSI_ARGS_((Tk_ItemType *typePtr));
-EXTERN void Tk_CreatePhotoImageFormat _ANSI_ARGS_((
- Tk_PhotoImageFormat *formatPtr));
-EXTERN void Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin,
- Atom selection, Atom target,
- Tk_SelectionProc *proc, ClientData clientData,
- Atom format));
-EXTERN Tk_Window Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window parent, char *name, char *screenName));
-EXTERN Tk_Window Tk_CreateWindowFromPath _ANSI_ARGS_((
- Tcl_Interp *interp, Tk_Window tkwin,
- char *pathName, char *screenName));
-EXTERN int Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Uid name, char *source, int width,
- int height));
-EXTERN void Tk_DefineCursor _ANSI_ARGS_((Tk_Window window,
- Tk_Cursor cursor));
-EXTERN void Tk_DeleteAllBindings _ANSI_ARGS_((
- Tk_BindingTable bindingTable, ClientData object));
-EXTERN int Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_BindingTable bindingTable, ClientData object,
- char *eventString));
-EXTERN void Tk_DeleteBindingTable _ANSI_ARGS_((
- Tk_BindingTable bindingTable));
-EXTERN void Tk_DeleteErrorHandler _ANSI_ARGS_((
- Tk_ErrorHandler handler));
-EXTERN void Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token,
- unsigned long mask, Tk_EventProc *proc,
- ClientData clientData));
-EXTERN void Tk_DeleteGenericHandler _ANSI_ARGS_((
- Tk_GenericProc *proc, ClientData clientData));
-EXTERN void Tk_DeleteImage _ANSI_ARGS_((Tcl_Interp *interp,
- char *name));
-EXTERN void Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin,
- Atom selection, Atom target));
-EXTERN void Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN char * Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN int Tk_DistanceToTextLayout _ANSI_ARGS_((
- Tk_TextLayout layout, int x, int y));
-EXTERN void Tk_Draw3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
- Drawable drawable, Tk_3DBorder border,
- XPoint *pointPtr, int numPoints, int borderWidth,
- int leftRelief));
-EXTERN void Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
- Drawable drawable, Tk_3DBorder border, int x,
- int y, int width, int height, int borderWidth,
- int relief));
-EXTERN void Tk_DrawChars _ANSI_ARGS_((Display *display,
- Drawable drawable, GC gc, Tk_Font tkfont,
- CONST char *source, int numChars, int x,
- int y));
-EXTERN void Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin,
- GC gc, int width, Drawable drawable));
-EXTERN void Tk_DrawTextLayout _ANSI_ARGS_((Display *display,
- Drawable drawable, GC gc, Tk_TextLayout layout,
- int x, int y, int firstChar, int lastChar));
-EXTERN void Tk_Fill3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
- Drawable drawable, Tk_3DBorder border,
- XPoint *pointPtr, int numPoints, int borderWidth,
- int leftRelief));
-EXTERN void Tk_Fill3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
- Drawable drawable, Tk_3DBorder border, int x,
- int y, int width, int height, int borderWidth,
- int relief));
-EXTERN Tk_PhotoHandle Tk_FindPhoto _ANSI_ARGS_((Tcl_Interp *interp,
- char *imageName));
-EXTERN Font Tk_FontId _ANSI_ARGS_((Tk_Font font));
-EXTERN void Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
-EXTERN void Tk_FreeBitmap _ANSI_ARGS_((Display *display,
- Pixmap bitmap));
-EXTERN void Tk_FreeColor _ANSI_ARGS_((XColor *colorPtr));
-EXTERN void Tk_FreeColormap _ANSI_ARGS_((Display *display,
- Colormap colormap));
-EXTERN void Tk_FreeCursor _ANSI_ARGS_((Display *display,
- Tk_Cursor cursor));
-EXTERN void Tk_FreeFont _ANSI_ARGS_((Tk_Font));
-EXTERN void Tk_FreeGC _ANSI_ARGS_((Display *display, GC gc));
-EXTERN void Tk_FreeImage _ANSI_ARGS_((Tk_Image image));
-EXTERN void Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec *specs,
- char *widgRec, Display *display, int needFlags));
-EXTERN void Tk_FreePixmap _ANSI_ARGS_((Display *display,
- Pixmap pixmap));
-EXTERN void Tk_FreeTextLayout _ANSI_ARGS_((
- Tk_TextLayout textLayout));
-EXTERN void Tk_FreeXId _ANSI_ARGS_((Display *display, XID xid));
-EXTERN GC Tk_GCForColor _ANSI_ARGS_((XColor *colorPtr,
- Drawable drawable));
-EXTERN void Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin,
- int reqWidth, int reqHeight));
-EXTERN Tk_3DBorder Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_Uid colorName));
-EXTERN void Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_BindingTable bindingTable, ClientData object));
-EXTERN int Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, Tk_Anchor *anchorPtr));
-EXTERN char * Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin,
- Atom atom));
-EXTERN char * Tk_GetBinding _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_BindingTable bindingTable, ClientData object,
- char *eventString));
-EXTERN Pixmap Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_Uid string));
-EXTERN Pixmap Tk_GetBitmapFromData _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *source,
- int width, int height));
-EXTERN int Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *capPtr));
-EXTERN XColor * Tk_GetColor _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_Uid name));
-EXTERN XColor * Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
- XColor *colorPtr));
-EXTERN Colormap Tk_GetColormap _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *string));
-EXTERN Tk_Cursor Tk_GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_Uid string));
-EXTERN Tk_Cursor Tk_GetCursorFromData _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *source, char *mask,
- int width, int height, int xHot, int yHot,
- Tk_Uid fg, Tk_Uid bg));
-EXTERN Tk_Font Tk_GetFont _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, CONST char *string));
-EXTERN Tk_Font Tk_GetFontFromObj _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tcl_Obj *objPtr));
-EXTERN void Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font,
- Tk_FontMetrics *fmPtr));
-EXTERN GC Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin,
- unsigned long valueMask, XGCValues *valuePtr));
-/* CYGNUS LOCAL. */
-EXTERN GC Tk_GetGCColor _ANSI_ARGS_((Tk_Window tkwin,
- unsigned long valueMask, XGCValues *valuePtr,
- XColor *foreground, XColor *background));
-EXTERN Tk_Image Tk_GetImage _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *name,
- Tk_ImageChangedProc *changeProc,
- ClientData clientData));
-EXTERN ClientData Tk_GetImageMasterData _ANSI_ARGS_ ((Tcl_Interp *interp,
- char *name, Tk_ImageType **typePtrPtr));
-EXTERN Tk_ItemType * Tk_GetItemTypes _ANSI_ARGS_((void));
-EXTERN int Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *joinPtr));
-EXTERN int Tk_GetJustify _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, Tk_Justify *justifyPtr));
-EXTERN int Tk_GetNumMainWindows _ANSI_ARGS_((void));
-EXTERN Tk_Uid Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin, char *name,
- char *className));
-EXTERN int Tk_GetPixels _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *string, int *intPtr));
-EXTERN Pixmap Tk_GetPixmap _ANSI_ARGS_((Display *display, Drawable d,
- int width, int height, int depth));
-EXTERN int Tk_GetRelief _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, int *reliefPtr));
-EXTERN void Tk_GetRootCoords _ANSI_ARGS_ ((Tk_Window tkwin,
- int *xPtr, int *yPtr));
-EXTERN int Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, double *dblPtr,
- int *intPtr));
-EXTERN int Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *string, double *doublePtr));
-EXTERN int Tk_GetSelection _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Atom selection, Atom target,
- Tk_GetSelProc *proc, ClientData clientData));
-EXTERN Tk_Uid Tk_GetUid _ANSI_ARGS_((CONST char *string));
-EXTERN Visual * Tk_GetVisual _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *string, int *depthPtr,
- Colormap *colormapPtr));
-EXTERN void Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin,
- int *xPtr, int *yPtr, int *widthPtr,
- int *heightPtr));
-EXTERN int Tk_Grab _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, int grabGlobal));
-EXTERN void Tk_HandleEvent _ANSI_ARGS_((XEvent *eventPtr));
-EXTERN Tk_Window Tk_IdToWindow _ANSI_ARGS_((Display *display,
- Window window));
-EXTERN void Tk_ImageChanged _ANSI_ARGS_((
- Tk_ImageMaster master, int x, int y,
- int width, int height, int imageWidth,
- int imageHeight));
-EXTERN int Tk_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN Atom Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin,
- char *name));
-EXTERN int Tk_IntersectTextLayout _ANSI_ARGS_((
- Tk_TextLayout layout, int x, int y, int width,
- int height));
-EXTERN void Tk_Main _ANSI_ARGS_((int argc, char **argv,
- Tcl_AppInitProc *appInitProc));
-EXTERN void Tk_MainLoop _ANSI_ARGS_((void));
-EXTERN void Tk_MaintainGeometry _ANSI_ARGS_((Tk_Window slave,
- Tk_Window master, int x, int y, int width,
- int height));
-EXTERN Tk_Window Tk_MainWindow _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin,
- Tk_GeomMgr *mgrPtr, ClientData clientData));
-EXTERN void Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN int Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
- CONST char *source, int maxChars, int maxPixels,
- int flags, int *lengthPtr));
-EXTERN void Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
- int x, int y, int width, int height));
-EXTERN void Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x,
- int y));
-EXTERN void Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin,
- int x, int y));
-EXTERN char * Tk_NameOf3DBorder _ANSI_ARGS_((Tk_3DBorder border));
-EXTERN char * Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
-EXTERN char * Tk_NameOfBitmap _ANSI_ARGS_((Display *display,
- Pixmap bitmap));
-EXTERN char * Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
-EXTERN char * Tk_NameOfColor _ANSI_ARGS_((XColor *colorPtr));
-EXTERN char * Tk_NameOfCursor _ANSI_ARGS_((Display *display,
- Tk_Cursor cursor));
-EXTERN char * Tk_NameOfFont _ANSI_ARGS_((Tk_Font font));
-EXTERN char * Tk_NameOfImage _ANSI_ARGS_((
- Tk_ImageMaster imageMaster));
-EXTERN char * Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
-EXTERN char * Tk_NameOfJustify _ANSI_ARGS_((Tk_Justify justify));
-EXTERN char * Tk_NameOfRelief _ANSI_ARGS_((int relief));
-EXTERN Tk_Window Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp *interp,
- char *pathName, Tk_Window tkwin));
-EXTERN void Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin,
- Atom selection, Tk_LostSelProc *proc,
- ClientData clientData));
-EXTERN int Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, int *argcPtr, char **argv,
- Tk_ArgvInfo *argTable, int flags));
-EXTERN void Tk_PhotoPutBlock _ANSI_ARGS_((Tk_PhotoHandle handle,
- Tk_PhotoImageBlock *blockPtr, int x, int y,
- int width, int height));
-EXTERN void Tk_PhotoPutZoomedBlock _ANSI_ARGS_((
- Tk_PhotoHandle handle,
- Tk_PhotoImageBlock *blockPtr, int x, int y,
- int width, int height, int zoomX, int zoomY,
- int subsampleX, int subsampleY));
-EXTERN int Tk_PhotoGetImage _ANSI_ARGS_((Tk_PhotoHandle handle,
- Tk_PhotoImageBlock *blockPtr));
-EXTERN void Tk_PhotoBlank _ANSI_ARGS_((Tk_PhotoHandle handle));
-EXTERN void Tk_PhotoExpand _ANSI_ARGS_((Tk_PhotoHandle handle,
- int width, int height ));
-EXTERN void Tk_PhotoGetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
- int *widthPtr, int *heightPtr));
-EXTERN void Tk_PhotoSetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
- int width, int height));
-EXTERN int Tk_PointToChar _ANSI_ARGS_((Tk_TextLayout layout,
- int x, int y));
-EXTERN int Tk_PostscriptFontName _ANSI_ARGS_((Tk_Font tkfont,
- Tcl_DString *dsPtr));
-EXTERN void Tk_PreserveColormap _ANSI_ARGS_((Display *display,
- Colormap colormap));
-EXTERN void Tk_QueueWindowEvent _ANSI_ARGS_((XEvent *eventPtr,
- Tcl_QueuePosition position));
-EXTERN void Tk_RedrawImage _ANSI_ARGS_((Tk_Image image, int imageX,
- int imageY, int width, int height,
- Drawable drawable, int drawableX, int drawableY));
-EXTERN void Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
- int width, int height));
-EXTERN int Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin,
- int aboveBelow, Tk_Window other));
-EXTERN Tk_RestrictProc *Tk_RestrictEvents _ANSI_ARGS_((Tk_RestrictProc *proc,
- ClientData arg, ClientData *prevArgPtr));
-EXTERN int Tk_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN char * Tk_SetAppName _ANSI_ARGS_((Tk_Window tkwin,
- char *name));
-EXTERN void Tk_SetBackgroundFromBorder _ANSI_ARGS_((
- Tk_Window tkwin, Tk_3DBorder border));
-EXTERN void Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin,
- char *className));
-EXTERN void Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin,
- int reqWidth, int reqHeight, int gridWidth,
- int gridHeight));
-EXTERN void Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin,
- int width));
-EXTERN void Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin,
- unsigned long pixel));
-EXTERN void Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
- Tk_Window tkwin, Pixmap pixmap));
-EXTERN void Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin,
- unsigned long pixel));
-EXTERN void Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin,
- int width));
-EXTERN void Tk_SetWindowBorderPixmap _ANSI_ARGS_((Tk_Window tkwin,
- Pixmap pixmap));
-EXTERN void Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin,
- Colormap colormap));
-EXTERN int Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin,
- Visual *visual, int depth,
- Colormap colormap));
-EXTERN void Tk_SizeOfBitmap _ANSI_ARGS_((Display *display,
- Pixmap bitmap, int *widthPtr,
- int *heightPtr));
-EXTERN void Tk_SizeOfImage _ANSI_ARGS_((Tk_Image image,
- int *widthPtr, int *heightPtr));
-EXTERN int Tk_StrictMotif _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void Tk_TextLayoutToPostscript _ANSI_ARGS_((
- Tcl_Interp *interp, Tk_TextLayout layout));
-EXTERN int Tk_TextWidth _ANSI_ARGS_((Tk_Font font,
- CONST char *string, int numChars));
-EXTERN void Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
-EXTERN void Tk_UnderlineChars _ANSI_ARGS_((Display *display,
- Drawable drawable, GC gc, Tk_Font tkfont,
- CONST char *source, int x, int y, int firstChar,
- int lastChar));
-EXTERN void Tk_UnderlineTextLayout _ANSI_ARGS_((
- Display *display, Drawable drawable, GC gc,
- Tk_TextLayout layout, int x, int y,
- int underline));
-EXTERN void Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void Tk_UnmaintainGeometry _ANSI_ARGS_((Tk_Window slave,
- Tk_Window master));
-EXTERN void Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin,
- int x, int y, int state));
+#include "tkDecls.h"
/*
* Tcl commands exported by Tk:
*/
-EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ButtonCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_CanvasCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_CheckbuttonCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ClipboardCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ChooseColorCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_DestroyCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_EntryCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_EventCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_FrameCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_FocusCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_FontObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int Tk_GetOpenFileCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_GetSaveFileCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_GrabCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_GridCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ImageCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
-EXTERN int Tk_LabelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ListboxCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_LowerCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_MenuCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_MenubuttonCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_MessageBoxCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_MessageCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_OptionCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_RadiobuttonCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_RaiseCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ScaleCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ScrollbarCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_ToplevelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_UpdateCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-EXTERN int Tk_WinfoObjCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-EXTERN int Tk_WmCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
#endif /* RESOURCE_INCLUDED */
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+/*
+ * end block for C++
+ */
+
+#ifdef __cplusplus
+}
+#endif
+
#endif /* _TK */
+
+
diff --git a/tk/generic/tk3d.c b/tk/generic/tk3d.c
index 62139b5e333..3073d2dfcbd 100644
--- a/tk/generic/tk3d.c
+++ b/tk/generic/tk3d.c
@@ -13,33 +13,150 @@
* RCS: @(#) $Id$
*/
-#include <tk3d.h>
+#include "tk3d.h"
/*
- * Hash table to map from a border's values (color, etc.) to a
- * Border structure for those values.
+ * The following table defines the string values for reliefs, which are
+ * used by Tk_GetReliefFromObj.
*/
-static Tcl_HashTable borderTable;
-typedef struct {
- Tk_Uid colorName; /* Color for border. */
- Colormap colormap; /* Colormap used for allocating border
- * colors. */
- Screen *screen; /* Screen on which border will be drawn. */
-} BorderKey;
-
-static int initialized = 0; /* 0 means static structures haven't
- * been initialized yet. */
+static char *reliefStrings[] = {"flat", "groove", "raised", "ridge", "solid",
+ "sunken", (char *) NULL};
/*
* Forward declarations for procedures defined in this file:
*/
-static void BorderInit _ANSI_ARGS_((void));
+static void BorderInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupBorderObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeBorderObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
static int Intersect _ANSI_ARGS_((XPoint *a1Ptr, XPoint *a2Ptr,
XPoint *b1Ptr, XPoint *b2Ptr, XPoint *iPtr));
+static void InitBorderObj _ANSI_ARGS_((Tcl_Obj *objPtr));
static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
int distance, XPoint *p3Ptr));
+
+/*
+ * The following structure defines the implementation of the "border" Tcl
+ * object, used for drawing. The border object remembers the hash table entry
+ * associated with a border. The actual allocation and deallocation of the
+ * border should be done by the configuration package when the border option
+ * is set.
+ */
+
+static Tcl_ObjType borderObjType = {
+ "border", /* name */
+ FreeBorderObjProc, /* freeIntRepProc */
+ DupBorderObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Alloc3DBorderFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * Tk_3DBorder structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a token for a data structure describing a
+ * 3-D border. This token may be passed to procedures such as
+ * Tk_Draw3DRectangle and Tk_Free3DBorder. If an error prevented
+ * the border from being created then NULL is returned and an error
+ * message will be left in the interp's result.
+ *
+ * Side effects:
+ * The border is added to an internal database with a reference
+ * count. For each call to this procedure, there should eventually
+ * be a call to 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 != &borderObjType) {
+ InitBorderObj(objPtr);
+ }
+ borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkBorder, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (borderPtr != NULL) {
+ if (borderPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a border that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeBorderObjProc(objPtr);
+ borderPtr = NULL;
+ } else if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+
+ /*
+ * The object didn't point to the border that we wanted. Search
+ * the list of borders with the same name to see if one of the
+ * others is the right one.
+ */
+
+ /*
+ * If the cached value is NULL, either the object type was not a
+ * color going in, or the object is a color type but had
+ * previously been freed.
+ *
+ * If the value is not NULL, the internal rep is the value
+ * of the color the last time this object was accessed. Check
+ * the screen and colormap of the last access, and if they
+ * match, we are done.
+ */
+
+ if (borderPtr != NULL) {
+ TkBorder *firstBorderPtr =
+ (TkBorder *) Tcl_GetHashValue(borderPtr->hashPtr);
+ FreeBorderObjProc(objPtr);
+ for (borderPtr = firstBorderPtr ; borderPtr != NULL;
+ borderPtr = borderPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == borderPtr->screen)
+ && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+ borderPtr->resourceRefCount++;
+ borderPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ return (Tk_3DBorder) borderPtr;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call Tk_Get3DBorder to allocate a new border.
+ */
+
+ borderPtr = (TkBorder *) Tk_Get3DBorder(interp, tkwin,
+ Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
+ if (borderPtr != NULL) {
+ borderPtr->objRefCount++;
+ }
+ return (Tk_3DBorder) borderPtr;
+}
/*
*--------------------------------------------------------------
@@ -49,12 +166,11 @@ static void ShiftLine _ANSI_ARGS_((XPoint *p1Ptr, XPoint *p2Ptr,
* Create a data structure for displaying a 3-D border.
*
* Results:
- * The return value is a token for a data structure
- * describing a 3-D border. This token may be passed
- * to Tk_Draw3DRectangle and Tk_Free3DBorder. If an
- * error prevented the border from being created then
- * NULL is returned and an error message will be left
- * in interp->result.
+ * 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.
@@ -69,71 +185,75 @@ 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
+ char *colorName; /* String giving name of color
* for window background. */
{
- BorderKey key;
Tcl_HashEntry *hashPtr;
- register TkBorder *borderPtr;
+ TkBorder *borderPtr, *existingBorderPtr;
int new;
XGCValues gcValues;
+ XColor *bgColorPtr;
+ TkDisplay *dispPtr;
- if (!initialized) {
- BorderInit();
- }
-
- /*
- * First, check to see if there's already a border that will work
- * for this request.
- */
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
- key.colorName = colorName;
- key.colormap = Tk_Colormap(tkwin);
- key.screen = Tk_Screen(tkwin);
+ if (!dispPtr->borderInit) {
+ BorderInit(dispPtr);
+ }
- hashPtr = Tcl_CreateHashEntry(&borderTable, (char *) &key, &new);
+ hashPtr = Tcl_CreateHashEntry(&dispPtr->borderTable, colorName, &new);
if (!new) {
- borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
- borderPtr->refCount++;
+ 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 {
- XColor *bgColorPtr;
+ existingBorderPtr = NULL;
+ }
- /*
- * No satisfactory border exists yet. Initialize a new one.
- */
-
- bgColorPtr = Tk_GetColor(interp, tkwin, colorName);
- if (bgColorPtr == 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 = key.colormap;
- borderPtr->refCount = 1;
- borderPtr->bgColorPtr = bgColorPtr;
- borderPtr->darkColorPtr = NULL;
- borderPtr->lightColorPtr = NULL;
- borderPtr->shadow = None;
- borderPtr->bgGC = None;
- borderPtr->darkGC = None;
- borderPtr->lightGC = None;
- borderPtr->hashPtr = hashPtr;
- Tcl_SetHashValue(hashPtr, borderPtr);
-
- /*
- * Create the information for displaying the background color,
- * but delay the allocation of shadows until they are actually
- * needed for drawing.
- */
-
- gcValues.foreground = borderPtr->bgColorPtr->pixel;
- borderPtr->bgGC = Tk_GetGCColor(tkwin, GCForeground, &gcValues,
- borderPtr->bgColorPtr, NULL);
+ return 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;
}
@@ -209,7 +329,7 @@ Tk_NameOf3DBorder(border)
{
TkBorder *borderPtr = (TkBorder *) border;
- return ((BorderKey *) borderPtr->hashPtr->key.words)->colorName;
+ return borderPtr->hashPtr->key.string;
}
/*
@@ -304,34 +424,51 @@ void
Tk_Free3DBorder(border)
Tk_3DBorder border; /* Token for border to be released. */
{
- register TkBorder *borderPtr = (TkBorder *) border;
+ TkBorder *borderPtr = (TkBorder *) border;
Display *display = DisplayOfScreen(borderPtr->screen);
+ TkBorder *prevPtr;
- borderPtr->refCount--;
- if (borderPtr->refCount == 0) {
- TkpFreeBorder(borderPtr);
- if (borderPtr->bgColorPtr != NULL) {
- Tk_FreeColor(borderPtr->bgColorPtr);
- }
- if (borderPtr->darkColorPtr != NULL) {
- Tk_FreeColor(borderPtr->darkColorPtr);
- }
- if (borderPtr->lightColorPtr != NULL) {
- Tk_FreeColor(borderPtr->lightColorPtr);
- }
- if (borderPtr->shadow != None) {
- Tk_FreeBitmap(display, borderPtr->shadow);
- }
- if (borderPtr->bgGC != None) {
- Tk_FreeGC(display, borderPtr->bgGC);
- }
- if (borderPtr->darkGC != None) {
- Tk_FreeGC(display, borderPtr->darkGC);
+ 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);
}
- if (borderPtr->lightGC != None) {
- Tk_FreeGC(display, borderPtr->lightGC);
+ } else {
+ while (prevPtr->nextPtr != borderPtr) {
+ prevPtr = prevPtr->nextPtr;
}
- Tcl_DeleteHashEntry(borderPtr->hashPtr);
+ prevPtr->nextPtr = borderPtr->nextPtr;
+ }
+ if (borderPtr->objRefCount == 0) {
ckfree((char *) borderPtr);
}
}
@@ -339,6 +476,106 @@ Tk_Free3DBorder(border)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -366,6 +603,35 @@ Tk_SetBackgroundFromBorder(tkwin, border)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -408,8 +674,11 @@ Tk_GetRelief(interp, name, reliefPtr)
} else if ((c == 's') && (strncmp(name, "sunken", length) == 0)) {
*reliefPtr = TK_RELIEF_SUNKEN;
} else {
- sprintf(interp->result, "bad relief type \"%.50s\": must be %s",
+ 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;
@@ -707,6 +976,17 @@ Tk_Fill3DRectangle(tkwin, drawable, border, x, y, width,
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;
@@ -783,10 +1063,11 @@ Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
*/
static void
-BorderInit()
+BorderInit(dispPtr)
+ TkDisplay * dispPtr; /* Used to access thread-specific data. */
{
- initialized = 1;
- Tcl_InitHashTable(&borderTable, sizeof(BorderKey)/sizeof(int));
+ dispPtr->borderInit = 1;
+ Tcl_InitHashTable(&dispPtr->borderTable, TCL_STRING_KEYS);
}
/*
@@ -948,3 +1229,181 @@ Intersect(a1Ptr, a2Ptr, b1Ptr, b2Ptr, iPtr)
}
return 0;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Get3DBorderFromObj --
+ *
+ * Returns the border referred to by a Tcl object. The border must
+ * already have been allocated via a call to Tk_Alloc3DBorderFromObj
+ * or Tk_Get3DBorder.
+ *
+ * Results:
+ * Returns the Tk_3DBorder that matches the tkwin and the string rep
+ * of the name of the border given in objPtr.
+ *
+ * Side effects:
+ * If the object is not already a border, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_3DBorder
+Tk_Get3DBorderFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object whose string value selects
+ * a border. */
+{
+ TkBorder *borderPtr = NULL;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &borderObjType) {
+ InitBorderObj(objPtr);
+ }
+
+ /*
+ * 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 = &borderObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDebugBorder --
+ *
+ * This procedure returns debugging information about a border.
+ *
+ * Results:
+ * The return value is a list with one sublist for each TkBorder
+ * corresponding to "name". Each sublist has two elements that
+ * contain the resourceRefCount and objRefCount fields from the
+ * TkBorder structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkDebugBorder(tkwin, name)
+ Tk_Window tkwin; /* The window in which the border will be
+ * used (not currently used). */
+ char *name; /* Name of the desired color. */
+{
+ TkBorder *borderPtr;
+ Tcl_HashEntry *hashPtr;
+ Tcl_Obj *resultPtr, *objPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ resultPtr = Tcl_NewObj();
+ hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, name);
+ if (hashPtr != NULL) {
+ borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
+ if (borderPtr == NULL) {
+ panic("TkDebugBorder found empty hash table entry");
+ }
+ for ( ; (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(borderPtr->resourceRefCount));
+ Tcl_ListObjAppendElement(NULL, objPtr,
+ Tcl_NewIntObj(borderPtr->objRefCount));
+ Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
+ }
+ }
+ return resultPtr;
+}
+
+
diff --git a/tk/generic/tk3d.h b/tk/generic/tk3d.h
index 71115f2cf5f..c62cf12de5a 100644
--- a/tk/generic/tk3d.h
+++ b/tk/generic/tk3d.h
@@ -4,7 +4,7 @@
* Declarations of types and functions shared by the 3d border
* module.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * 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.
@@ -23,13 +23,13 @@
#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.
+ * 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 {
+typedef struct TkBorder {
Screen *screen; /* Screen on which the border will be used. */
Visual *visual; /* Visual for all windows and pixmaps using
* the border. */
@@ -37,8 +37,18 @@ typedef struct {
* the border will be used. */
Colormap colormap; /* Colormap out of which pixels are
* allocated. */
- int refCount; /* Number of different users of
- * this border. */
+ 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). */
@@ -63,6 +73,11 @@ typedef struct {
* 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;
@@ -85,3 +100,4 @@ EXTERN void TkpFreeBorder _ANSI_ARGS_((TkBorder *borderPtr));
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TK3D */
+
diff --git a/tk/generic/tkArgv.c b/tk/generic/tkArgv.c
index b44939ed7c4..ee86ad75cd4 100644
--- a/tk/generic/tkArgv.c
+++ b/tk/generic/tkArgv.c
@@ -5,7 +5,7 @@
* argv-argc parsing.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
+ * 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.
@@ -24,8 +24,8 @@
static Tk_ArgvInfo defaultTable[] = {
{"-help", TK_ARGV_HELP, (char *) NULL, (char *) NULL,
"Print summary of command-line options and abort"},
- {"-version", TK_ARGV_VERSION, (char *) NULL, (char *) NULL,
- "Print version number and abort"},
+ {"-version", TK_ARGV_VERSION, (char *) NULL, (char *) NULL,
+ "Print version number and abort"},
{NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
(char *) NULL}
};
@@ -47,7 +47,7 @@ static void PrintUsage _ANSI_ARGS_((Tcl_Interp *interp,
*
* Results:
* The return value is a standard Tcl return value. If an
- * error occurs then an error message is left in interp->result.
+ * 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
@@ -294,13 +294,17 @@ Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags)
argc -= 2;
break;
case TK_ARGV_VERSION:
- Tcl_AppendResult(interp, "Tk version ", TK_VERSION, "-foundry-971110",
+ Tcl_AppendResult(interp, "Tk version ", TK_VERSION, "-snavigator-99r1",
(char *) NULL);
return TCL_ERROR;
- default:
- sprintf(interp->result, "bad argument type %d in Tk_ArgvInfo",
+ 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;
+ }
}
}
@@ -334,7 +338,7 @@ Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags)
* Generate a help string describing command-line options.
*
* Results:
- * Interp->result will be modified to hold a help string
+ * 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.
@@ -359,7 +363,7 @@ PrintUsage(interp, argTable, flags)
int width, i, numSpaces;
#define NUM_SPACES 20
static char spaces[] = " ";
- char tmp[30];
+ char tmp[TCL_DOUBLE_SPACE];
/*
* First, compute the width of the widest option key, so that we
@@ -437,3 +441,4 @@ PrintUsage(interp, argTable, flags)
(char *) NULL);
}
}
+
diff --git a/tk/generic/tkAtom.c b/tk/generic/tkAtom.c
index 7bd2a1e80ff..45260d940e0 100644
--- a/tk/generic/tkAtom.c
+++ b/tk/generic/tkAtom.c
@@ -215,3 +215,4 @@ AtomInit(dispPtr)
}
}
}
+
diff --git a/tk/generic/tkBind.c b/tk/generic/tkBind.c
index 38a39b7e5b1..233f3c308c4 100644
--- a/tk/generic/tkBind.c
+++ b/tk/generic/tkBind.c
@@ -5,18 +5,22 @@
* with X events or sequences of X events.
*
* Copyright (c) 1989-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 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$
+ * RCS: @(#) $Id$
*/
#include "tkPort.h"
#include "tkInt.h"
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
/*
* File structure:
*
@@ -340,6 +344,8 @@ typedef struct BindInfo {
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;
/*
@@ -374,6 +380,7 @@ static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
*/
static int initialized = 0;
+TCL_DECLARE_MUTEX(bindMutex)
/*
* A hash table is kept to map from the string names of event
@@ -396,19 +403,15 @@ typedef struct {
* 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
-
-/*
- * 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)
+#define QUADRUPLE 4
+#define MULT_CLICKS 7
static ModInfo modArray[] = {
{"Control", ControlMask, 0},
@@ -441,6 +444,7 @@ static ModInfo modArray[] = {
{"M5", Mod5Mask, 0},
{"Double", 0, DOUBLE},
{"Triple", 0, TRIPLE},
+ {"Quadruple", 0, QUADRUPLE},
{"Any", 0, 0}, /* Ignored: historical relic. */
{NULL, 0, 0}
};
@@ -574,6 +578,20 @@ static int flagArray[TK_LASTEVENT] = {
};
/*
+ * 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
@@ -638,8 +656,6 @@ static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
VirtualEventTable *vetPtr));
static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
-static KeySym GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
- XEvent *eventPtr));
static void GetPatternString _ANSI_ARGS_((PatSeq *psPtr,
Tcl_DString *dsPtr));
static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
@@ -647,17 +663,21 @@ static int GetVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
static Tk_Uid GetVirtualEventUid _ANSI_ARGS_((Tcl_Interp *interp,
char *virtString));
static int HandleEventGenerate _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window main, int argc, char **argv));
-static void InitKeymapInfo _ANSI_ARGS_((TkDisplay *dispPtr));
+ 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,
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
@@ -705,37 +725,41 @@ TkBindInit(mainPtr)
*/
if (!initialized) {
- Tcl_HashEntry *hPtr;
- ModInfo *modPtr;
- EventInfo *eiPtr;
- int dummy;
+ 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);
- }
+ 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(&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);
+ 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;
}
- initialized = 1;
+ Tcl_MutexUnlock(&bindMutex);
}
mainPtr->bindingTable = Tk_CreateBindingTable(mainPtr->interp);
@@ -746,6 +770,7 @@ TkBindInit(mainPtr)
bindInfoPtr->screenInfo.curScreenIndex = -1;
bindInfoPtr->screenInfo.bindingDepth = 0;
bindInfoPtr->pendingList = NULL;
+ bindInfoPtr->deleted = 0;
mainPtr->bindInfo = (TkBindInfo) bindInfoPtr;
TkpInitializeMenuBindings(mainPtr->interp, mainPtr->bindingTable);
@@ -779,6 +804,8 @@ TkBindFree(mainPtr)
bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ bindInfoPtr->deleted = 1;
+ Tcl_EventuallyFree((ClientData) bindInfoPtr, Tcl_Free);
mainPtr->bindInfo = NULL;
}
@@ -791,7 +818,7 @@ TkBindFree(mainPtr)
*
* Results:
* The return value is a token for the new table, which must
- * be passed to procedures like Tk_CreatBinding.
+ * be passed to procedures like Tk_CreateBinding.
*
* Side effects:
* Memory is allocated for the new table.
@@ -893,7 +920,7 @@ Tk_DeleteBindingTable(bindingTable)
* Results:
* The return value is 0 if an error occurred while setting
* up the binding. In this case, an error message will be
- * left in interp->result. If all went well then the return
+ * 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
@@ -998,7 +1025,7 @@ Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
* Results:
* The return value is 0 if an error occurred while setting
* up the binding. In this case, an error message will be
- * left in interp->result. If all went well then the return
+ * 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
@@ -1082,7 +1109,7 @@ TkCreateBindingProcedure(interp, bindingTable, object, eventString,
*
* Results:
* The result is a standard Tcl return value. If an error
- * occurs then interp->result will contain an error message.
+ * occurs then the interp's result will contain an error message.
*
* Side effects:
* The binding given by object and eventString is removed
@@ -1177,7 +1204,7 @@ Tk_DeleteBinding(interp, bindingTable, object, eventString)
* given by bindingTable. If there is no binding for
* eventString, or if eventString is improperly formed,
* then NULL is returned and an error message is left in
- * interp->result. The return value is semi-static: it
+ * the interp's result. The return value is semi-static: it
* will persist until the binding is changed or deleted.
*
* Side effects:
@@ -1220,7 +1247,7 @@ Tk_GetBinding(interp, bindingTable, object, eventString)
* associated with a given object.
*
* Results:
- * There is no return value. Interp->result is modified to
+ * 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.
@@ -1384,9 +1411,9 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
{
BindingTable *bindPtr;
TkDisplay *dispPtr;
+ ScreenInfo *screenPtr;
BindInfo *bindInfoPtr;
TkDisplay *oldDispPtr;
- ScreenInfo *screenPtr;
XEvent *ringPtr;
PatSeq *vMatchDetailList, *vMatchNoDetailList;
int flags, oldScreen, i, deferModal;
@@ -1496,7 +1523,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
detail.clientData = 0;
flags = flagArray[ringPtr->type];
if (flags & KEY) {
- detail.keySym = GetKeySym(dispPtr, ringPtr);
+ detail.keySym = TkpGetKeySym(dispPtr, ringPtr);
if (detail.keySym == NoSymbol) {
detail.keySym = 0;
}
@@ -1617,12 +1644,12 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
unsigned int oldSize, newSize;
oldSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
matchSpace *= 2;
newSize = sizeof(staticPending)
- - sizeof(staticPending.matchArray)
- + matchSpace * sizeof(PatSeq*);
+ - sizeof(staticPending.matchArray)
+ + matchSpace * sizeof(PatSeq*);
new = (PendingBinding *) ckalloc(newSize);
memcpy((VOID *) new, (VOID *) pendingPtr, oldSize);
if (pendingPtr != &staticPending) {
@@ -1653,7 +1680,7 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
*
* There are two tricks here:
* 1. Bindings can be invoked from in the middle of Tcl commands,
- * where interp->result is significant (for example, a widget
+ * 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,
@@ -1684,6 +1711,13 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
}
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;
@@ -1703,10 +1737,20 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
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;
- screenPtr->bindingDepth++;
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth++;
+ }
Tcl_AllowExceptions(interp);
if (*p == '\0') {
@@ -1732,7 +1776,10 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
p += strlen(p);
}
p++;
- screenPtr->bindingDepth--;
+
+ if (!bindInfoPtr->deleted) {
+ screenPtr->bindingDepth--;
+ }
if (code != TCL_OK) {
if (code == TCL_CONTINUE) {
/*
@@ -1762,8 +1809,8 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
}
}
- if ((screenPtr->bindingDepth != 0) &&
- ((oldDispPtr != screenPtr->curDispPtr)
+ if (!bindInfoPtr->deleted && (screenPtr->bindingDepth != 0)
+ && ((oldDispPtr != screenPtr->curDispPtr)
|| (oldScreen != screenPtr->curScreenIndex))) {
/*
@@ -1780,19 +1827,27 @@ Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
Tcl_DStringFree(&scripts);
if (matchCount > 0) {
- PendingBinding **curPtrPtr;
+ 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;
+ for (curPtrPtr = &bindInfoPtr->pendingList; ; ) {
+ if (*curPtrPtr == pendingPtr) {
+ *curPtrPtr = pendingPtr->nextPtr;
+ break;
+ }
+ curPtrPtr = &(*curPtrPtr)->nextPtr;
}
- curPtrPtr = &(*curPtrPtr)->nextPtr;
}
if (pendingPtr != &staticPending) {
ckfree((char *) pendingPtr);
}
}
+ Tcl_Release((ClientData) bindInfoPtr);
}
/*
@@ -2016,6 +2071,14 @@ MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
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;
}
@@ -2167,7 +2230,8 @@ MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
bestPtr = matchPtr;
bestSourcePtr = sourcePtr;
- nextSequence: continue;
+ nextSequence:
+ continue;
}
*sourcePtrPtr = bestSourcePtr;
@@ -2211,8 +2275,11 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
int number, flags, length;
#define NUM_SIZE 40
char *string;
+ Tcl_DString buf;
char numStorage[NUM_SIZE+1];
+ Tcl_DStringInit(&buf);
+
if (eventPtr->type < TK_LASTEVENT) {
flags = flagArray[eventPtr->type];
} else {
@@ -2246,8 +2313,10 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
number = eventPtr->xany.serial;
goto doNumber;
case 'a':
- TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
- string = numStorage;
+ if (flags & CONFIG) {
+ TkpPrintWindowId(numStorage, eventPtr->xconfigure.above);
+ string = numStorage;
+ }
goto doString;
case 'b':
number = eventPtr->xbutton.button;
@@ -2361,37 +2430,8 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
goto doNumber;
case 'A':
if (flags & KEY) {
- int numChars;
-
- /*
- * If we're using input methods and this is a keypress
- * event, invoke XmbTkFindStateString. Otherwise just use
- * the older XTkFindStateString.
- */
-
-#ifdef TK_USE_INPUT_METHODS
- Status status;
- if ((winPtr->inputContext != NULL)
- && (eventPtr->type == KeyPress)) {
- numChars = XmbLookupString(winPtr->inputContext,
- &eventPtr->xkey, numStorage, NUM_SIZE,
- (KeySym *) NULL, &status);
- if ((status != XLookupChars)
- && (status != XLookupBoth)) {
- numChars = 0;
- }
- } else {
- numChars = XLookupString(&eventPtr->xkey, numStorage,
- NUM_SIZE, (KeySym *) NULL,
- (XComposeStatus *) NULL);
- }
-#else /* TK_USE_INPUT_METHODS */
- numChars = XLookupString(&eventPtr->xkey, numStorage,
- NUM_SIZE, (KeySym *) NULL,
- (XComposeStatus *) NULL);
-#endif /* TK_USE_INPUT_METHODS */
- numStorage[numChars] = '\0';
- string = numStorage;
+ Tcl_DStringFree(&buf);
+ string = TkpGetString(winPtr, eventPtr, &buf);
}
goto doString;
case 'B':
@@ -2492,6 +2532,7 @@ ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
before += 2;
}
+ Tcl_DStringFree(&buf);
}
/*
@@ -2524,7 +2565,7 @@ ChangeScreen(interp, dispName, screenIndex)
{
Tcl_DString cmd;
int code;
- char screen[30];
+ char screen[TCL_INTEGER_SPACE];
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, "tkScreenChanged ", 16);
@@ -2558,87 +2599,96 @@ ChangeScreen(interp, dispName, screenIndex)
*/
int
-Tk_EventCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_EventObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i;
- size_t length;
- char *option;
+ int index;
Tk_Window tkwin;
VirtualEventTable *vetPtr;
TkBindInfo bindInfo;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg1?\"", (char *) NULL);
- return TCL_ERROR;
- }
-
- option = argv[1];
- length = strlen(option);
- if (length == 0) {
- goto badopt;
- }
+ static char *optionStrings[] = {
+ "add", "delete", "generate", "info",
+ NULL
+ };
+ enum options {
+ EVENT_ADD, EVENT_DELETE, EVENT_GENERATE, EVENT_INFO
+ };
tkwin = (Tk_Window) clientData;
bindInfo = ((TkWindow *) tkwin)->mainPtr->bindInfo;
vetPtr = &((BindInfo *) bindInfo)->virtualEventTable;
- if (strncmp(option, "add", length) == 0) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " add virtual sequence ?sequence ...?\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (i = 3; i < argc; i++) {
- if (CreateVirtualEvent(interp, vetPtr, argv[2], argv[i])
- != TCL_OK) {
+ 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;
}
- } else if (strncmp(option, "delete", length) == 0) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " delete virtual ?sequence sequence ...?\"",
- (char *) NULL);
- return TCL_ERROR;
- }
- if (argc == 3) {
- return DeleteVirtualEvent(interp, vetPtr, argv[2], NULL);
- }
- for (i = 3; i < argc; i++) {
- if (DeleteVirtualEvent(interp, vetPtr, argv[2], argv[i])
- != TCL_OK) {
+ 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;
}
- } else if (strncmp(option, "generate", length) == 0) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " generate window event ?options?\"", (char *) NULL);
- return TCL_ERROR;
+ 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);
}
- return HandleEventGenerate(interp, tkwin, argc - 2, argv + 2);
- } else if (strncmp(option, "info", length) == 0) {
- if (argc == 2) {
- GetAllVirtualEvents(interp, vetPtr);
- return TCL_OK;
- } else if (argc == 3) {
- return GetVirtualEvent(interp, vetPtr, argv[2]);
- } else {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " info ?virtual?\"", (char *) NULL);
- return TCL_ERROR;
+ 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;
+ }
}
- } else {
- badopt:
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": should be add, delete, generate, info", (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
}
@@ -2725,8 +2775,8 @@ DeleteVirtualEventTable(vetPtr)
* Results:
* The return value is TCL_ERROR if an error occured while
* creating the virtual binding. In this case, an error message
- * will be left in interp->result. If all went well then the return
- * value is TCL_OK.
+ * 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
@@ -2831,7 +2881,7 @@ CreateVirtualEvent(interp, vetPtr, virtString, eventString)
*
* Results:
* The result is a standard Tcl return value. If an error
- * occurs then interp->result will contain an error message.
+ * 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.
*
@@ -2883,7 +2933,10 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
eventPSPtr = FindSequence(interp, &vetPtr->patternTable, NULL,
eventString, 0, 0, &eventMask);
if (eventPSPtr == NULL) {
- return (interp->result[0] != '\0') ? TCL_ERROR : TCL_OK;
+ char *string;
+
+ string = Tcl_GetStringResult(interp);
+ return (string[0] != '\0') ? TCL_ERROR : TCL_OK;
}
}
@@ -2924,7 +2977,7 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
} else {
for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
if (prevPtr == NULL) {
- panic("Tk_DeleteVirtualEvent couldn't find on hash chain");
+ panic("DeleteVirtualEvent couldn't find on hash chain");
}
if (prevPtr->nextSeqPtr == psPtr) {
prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
@@ -2985,12 +3038,12 @@ DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
* given virtual event.
*
* Results:
- * The return value is TCL_OK and interp->result is filled with the
+ * 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, interp->result is filled with and empty string. If the
+ * 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 interp->result.
+ * returned and an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -3042,7 +3095,7 @@ GetVirtualEvent(interp, vetPtr, virtString)
* event defined.
*
* Results:
- * There is no return value. Interp->result is modified to
+ * 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.
*
@@ -3111,56 +3164,75 @@ GetAllVirtualEvents(interp, vetPtr)
*---------------------------------------------------------------------------
*/
static int
-HandleEventGenerate(interp, mainwin, argc, argv)
- Tcl_Interp *interp; /* Interp for error messages and name lookup. */
- Tk_Window mainwin; /* Main window associated with interp. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+HandleEventGenerate(interp, mainWin, objc, objv)
+ Tcl_Interp *interp; /* Interp for errors return and name lookup. */
+ Tk_Window mainWin; /* Main window associated with interp. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ XEvent event;
+ char *name, *p, *windowName;
+ int count, flags, synch, i, number, warp;
+ Tcl_QueuePosition pos;
Pattern pat;
- Tk_Window tkwin;
- char *p;
+ Tk_Window tkwin, tkwin2;
+ TkWindow *mainPtr;
unsigned long eventMask;
- int count, i, state, flags, synch;
- Tcl_QueuePosition pos;
- XEvent event;
+ static char *fieldStrings[] = {
+ "-when", "-above", "-borderwidth", "-button",
+ "-count", "-delta", "-detail", "-focus",
+ "-height",
+ "-keycode", "-keysym", "-mode", "-override",
+ "-place", "-root", "-rootx", "-rooty",
+ "-sendevent", "-serial", "-state", "-subwindow",
+ "-time", "-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;
+ }
- if (argv[0][0] == '.') {
- tkwin = Tk_NameToWindow(interp, argv[0], mainwin);
- if (tkwin == NULL) {
- return TCL_ERROR;
- }
- } else {
- if (TkpScanWindowId(NULL, argv[0], &i) != TCL_OK) {
- Tcl_AppendResult(interp, "bad window name/identifier \"",
- argv[0], "\"", (char *) NULL);
- return TCL_ERROR;
- }
- tkwin = Tk_IdToWindow(Tk_Display(mainwin), (Window) i);
- if ((tkwin == NULL) || (((TkWindow *) mainwin)->mainPtr
- != ((TkWindow *) tkwin)->mainPtr)) {
- Tcl_AppendResult(interp, "window id \"", argv[0],
- "\" doesn't exist in this application", (char *) NULL);
- return TCL_ERROR;
- }
+ 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;
}
- p = argv[1];
+ 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) {
- interp->result = "Double or Triple modifier not allowed";
+ Tcl_SetResult(interp, "Double or Triple modifier not allowed",
+ TCL_STATIC);
return TCL_ERROR;
}
if (*p != '\0') {
- interp->result = "only one event specification allowed";
- return TCL_ERROR;
- }
- if (argc & 1) {
- Tcl_AppendResult(interp, "value for \"", argv[argc - 1],
- "\" missing", (char *) NULL);
+ Tcl_SetResult(interp, "only one event specification allowed",
+ TCL_STATIC);
return TCL_ERROR;
}
@@ -3168,41 +3240,18 @@ HandleEventGenerate(interp, mainwin, argc, argv)
event.xany.type = pat.eventType;
event.xany.serial = NextRequest(Tk_Display(tkwin));
event.xany.send_event = False;
- event.xany.window = Tk_WindowId(tkwin);
+ 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)) {
- /*
- * When mapping from a keysym to a keycode, need information about
- * the modifier state that should be used so that when they call
- * XKeycodeToKeysym taking into account the xkey.state, they will
- * get back the original keysym.
- */
-
- if (pat.detail.keySym == NoSymbol) {
- event.xkey.keycode = 0;
- } else {
- event.xkey.keycode = XKeysymToKeycode(event.xany.display,
- pat.detail.keySym);
- }
- if (event.xkey.keycode != 0) {
- for (state = 0; state < 4; state++) {
- if (XKeycodeToKeysym(event.xany.display,
- event.xkey.keycode, state) == pat.detail.keySym) {
- if (state & 1) {
- event.xkey.state |= ShiftMask;
- }
- if (state & 2) {
- TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- event.xkey.state |= dispPtr->modeModMask;
- }
- break;
- }
- }
- }
+ TkpSetKeycodeAndState(tkwin, pat.detail.keySym, &event);
} else if (flags & BUTTON) {
event.xbutton.button = pat.detail.button;
} else if (flags & VIRTUAL) {
@@ -3219,383 +3268,495 @@ HandleEventGenerate(interp, mainwin, argc, argv)
*/
synch = 1;
+ warp = 0;
pos = TCL_QUEUE_TAIL;
- for (i = 2; i < argc; i += 2) {
- char *field, *value;
- Tk_Window tkwin2;
- int number;
- KeySym keysym;
+ for (i = 2; i < objc; i += 2) {
+ Tcl_Obj *optionPtr, *valuePtr;
+ int index;
- field = argv[i];
- value = argv[i+1];
-
- if (strcmp(field, "-when") == 0) {
- if (strcmp(value, "now") == 0) {
- synch = 1;
- } else if (strcmp(value, "head") == 0) {
- pos = TCL_QUEUE_HEAD;
- synch = 0;
- } else if (strcmp(value, "mark") == 0) {
- pos = TCL_QUEUE_MARK;
- synch = 0;
- } else if (strcmp(value, "tail") == 0) {
- pos = TCL_QUEUE_TAIL;
- synch = 0;
- } else {
- Tcl_AppendResult(interp, "bad position \"", value,
- "\": should be now, head, mark, tail", (char *) NULL);
- return TCL_ERROR;
- }
- } else if (strcmp(field, "-above") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
- return TCL_ERROR;
- }
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & CONFIG) {
- event.xconfigure.above = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-borderwidth") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & (CREATE|CONFIG)) {
- event.xcreatewindow.border_width = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-button") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & BUTTON) {
- event.xbutton.button = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-count") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & EXPOSE) {
- event.xexpose.count = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-delta") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
- event.xkey.keycode = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-detail") == 0) {
- number = TkFindStateNum(interp, field, notifyDetail, value);
- if (number < 0) {
- return TCL_ERROR;
- }
- if (flags & FOCUS) {
- event.xfocus.detail = number;
- } else if (flags & CROSSING) {
- event.xcrossing.detail = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-focus") == 0) {
- if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & CROSSING) {
- event.xcrossing.focus = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-height") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if (flags & EXPOSE) {
- event.xexpose.height = number;
- } else if (flags & CONFIG) {
- event.xconfigure.height = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-keycode") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
- }
- if ((flags & KEY) && (event.xkey.type != MouseWheelEvent)) {
- event.xkey.keycode = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-keysym") == 0) {
- keysym = TkStringToKeysym(value);
- if (keysym == NoSymbol) {
- Tcl_AppendResult(interp, "unknown keysym \"", value,
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
+ 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) {
/*
- * 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.
+ * 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.
*/
- number = XKeysymToKeycode(event.xany.display, keysym);
- if (number == 0) {
- Tcl_AppendResult(interp, "no keycode for keysym \"", value,
- "\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (state = 0; state < 4; state++) {
- if (XKeycodeToKeysym(event.xany.display, (unsigned) number,
- state) == keysym) {
- if (state & 1) {
- event.xkey.state |= ShiftMask;
- }
- if (state & 2) {
- TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- event.xkey.state |= dispPtr->modeModMask;
- }
- break;
+ 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) && (event.xkey.type != MouseWheelEvent)) {
- event.xkey.keycode = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-mode") == 0) {
- number = TkFindStateNum(interp, field, notifyMode, value);
- if (number < 0) {
- return TCL_ERROR;
- }
- if (flags & CROSSING) {
- event.xcrossing.mode = number;
- } else if (flags & FOCUS) {
- event.xfocus.mode = number;
- } else {
- goto badopt;
+ if (!(flags & (KEY_BUTTON_MOTION_VIRTUAL))) {
+ goto badopt;
+ }
+ break;
}
- } else if (strcmp(field, "-override") == 0) {
- if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- 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;
+ 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;
}
- } else if (strcmp(field, "-place") == 0) {
- number = TkFindStateNum(interp, field, circPlace, value);
- if (number < 0) {
- return TCL_ERROR;
+ 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;
}
- if (flags & CIRC) {
- event.xcirculate.place = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-root") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
+ case EVENT_COUNT: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
+ if (flags & EXPOSE) {
+ event.xexpose.count = number;
+ } else {
+ goto badopt;
+ }
+ break;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.root = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-rootx") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.x_root = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-rooty") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.y_root = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-sendevent") == 0) {
- if (isdigit(UCHAR(value[0]))) {
- /*
- * Allow arbitrary integer values for the field; they
- * are needed by a few of the tests in the Tk test suite.
- */
-
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ 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;
}
- } else {
- if (Tcl_GetBoolean(interp, value, &number) != TCL_OK) {
+
+ 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;
}
- event.xany.send_event = number;
- } else if (strcmp(field, "-serial") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- event.xany.serial = number;
- } else if (strcmp(field, "-state") == 0) {
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ case EVENT_OVERRIDE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &number) != TCL_OK) {
return TCL_ERROR;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
- event.xkey.state = number;
+ 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 {
- event.xcrossing.state = number;
+ goto badopt;
}
- } else if (flags & VISIBILITY) {
- number = TkFindStateNum(interp, field, visNotify, value);
+ break;
+ }
+ case EVENT_PLACE: {
+ number = TkFindStateNumObj(interp, optionPtr, circPlace,
+ valuePtr);
if (number < 0) {
return TCL_ERROR;
}
- event.xvisibility.state = number;
- } else {
- goto badopt;
- }
- } else if (strcmp(field, "-subwindow") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
+ 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;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.root = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.subwindow = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-time") == 0) {
- if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
- event.xkey.time = (Time) number;
- } else if (flags & PROP) {
- event.xproperty.time = (Time) number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-width") == 0) {
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ case EVENT_SERIAL: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ event.xany.serial = number;
+ break;
}
- if (flags & EXPOSE) {
- event.xexpose.width = number;
- } else if (flags & (CREATE|CONFIG)) {
- event.xcreatewindow.width = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-window") == 0) {
- if (value[0] == '.') {
- tkwin2 = Tk_NameToWindow(interp, value, mainwin);
- if (tkwin2 == NULL) {
+ case EVENT_SUBWINDOW: {
+ if (NameToWindow(interp, tkwin, valuePtr, &tkwin2) != TCL_OK) {
return TCL_ERROR;
}
- number = Tk_WindowId(tkwin2);
- } else if (TkpScanWindowId(interp, value, &number)
- != TCL_OK) {
- return TCL_ERROR;
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL|CROSSING)) {
+ event.xkey.subwindow = Tk_WindowId(tkwin2);
+ } else {
+ goto badopt;
+ }
+ break;
}
- if (flags & (CREATE|DESTROY|UNMAP|MAP|REPARENT|CONFIG
- |GRAVITY|CIRC)) {
- event.xcreatewindow.window = number;
- } else {
- goto badopt;
+ 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;
}
- } else if (strcmp(field, "-x") == 0) {
- int rootX, rootY;
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- 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;
+ 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;
}
- } else if (strcmp(field, "-y") == 0) {
- int rootX, rootY;
- if (Tk_GetPixels(interp, tkwin, value, &number) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- 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;
+ 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;
}
- } else {
- badopt:
- Tcl_AppendResult(interp, "bad option to ", argv[1],
- " event: \"", field, "\"", (char *) NULL);
- return TCL_ERROR;
}
+ 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->warpInProgress) {
+ Tcl_DoWhenIdle(DoWarp, (ClientData) dispPtr);
+ dispPtr->warpInProgress = 1;
+ }
+ 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;
+ int id;
+
+ name = Tcl_GetStringFromObj(objPtr, NULL);
+ if (name[0] == '.') {
+ tkwin = Tk_NameToWindow(interp, name, mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ *tkwinPtr = tkwin;
+ } else {
+ if (TkpScanWindowId(NULL, name, &id) != TCL_OK) {
+ Tcl_AppendResult(interp, "bad window name/identifier \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *tkwinPtr = Tk_IdToWindow(Tk_Display(mainWin), (Window) id);
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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->warpInProgress = 0;
}
/*
@@ -3609,7 +3770,7 @@ HandleEventGenerate(interp, mainwin, argc, argv)
* Results:
* The return value is NULL if the virtual event string was
* not in the proper format. In this case, an error message
- * will be left in interp->result. Otherwise the return
+ * will be left in the interp's result. Otherwise the return
* value is a Tk_Uid that represents the virtual event.
*
* Side effects:
@@ -3655,7 +3816,7 @@ GetVirtualEventUid(interp, virtString)
* in patternTable that corresponds to eventString. If an error
* was found while parsing eventString, or if "create" is 0 and
* no pattern sequence previously existed, then NULL is returned
- * and interp->result contains a message describing the problem.
+ * 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
@@ -3731,27 +3892,23 @@ FindSequence(interp, patternTablePtr, object, eventString, create,
if (eventMask & VirtualEventMask) {
if (allowVirtual == 0) {
- interp->result =
- "virtual event not allowed in definition of another virtual event";
+ Tcl_SetResult(interp,
+ "virtual event not allowed in definition of another virtual event",
+ TCL_STATIC);
return NULL;
}
virtualFound = 1;
}
/*
- * Replicate events for DOUBLE and TRIPLE.
+ * Replicate events for DOUBLE, TRIPLE, QUADRUPLE.
*/
- if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ while ((count-- > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
flags |= PAT_NEARBY;
patPtr[-1] = patPtr[0];
patPtr--;
numPats++;
- if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
- patPtr[-1] = patPtr[0];
- patPtr--;
- numPats++;
- }
}
}
@@ -3763,11 +3920,12 @@ FindSequence(interp, patternTablePtr, object, eventString, create,
*/
if (numPats == 0) {
- interp->result = "no events specified in binding";
+ Tcl_SetResult(interp, "no events specified in binding", TCL_STATIC);
return NULL;
}
if ((numPats > 1) && (virtualFound != 0)) {
- interp->result = "virtual events may not be composed";
+ Tcl_SetResult(interp, "virtual events may not be composed",
+ TCL_STATIC);
return NULL;
}
@@ -3793,6 +3951,14 @@ FindSequence(interp, patternTablePtr, object, eventString, 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)
@@ -3882,8 +4048,10 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
if (isprint(UCHAR(*p))) {
patPtr->detail.keySym = *p;
} else {
- sprintf(interp->result,
- "bad ASCII character 0x%x", (unsigned char) *p);
+ char buf[64];
+
+ sprintf(buf, "bad ASCII character 0x%x", (unsigned char) *p);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return 0;
}
}
@@ -3923,11 +4091,13 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
char *field = p + 1;
p = strchr(field, '>');
if (p == field) {
- interp->result = "virtual event \"<<>>\" is badly formed";
+ Tcl_SetResult(interp, "virtual event \"<<>>\" is badly formed",
+ TCL_STATIC);
return 0;
}
if ((p == NULL) || (p[1] != '>')) {
- interp->result = "missing \">\" in virtual binding";
+ Tcl_SetResult(interp, "missing \">\" in virtual binding",
+ TCL_STATIC);
return 0;
}
*p = '\0';
@@ -3957,12 +4127,10 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
}
modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
patPtr->needMods |= modPtr->mask;
- if (modPtr->flags & (DOUBLE|TRIPLE)) {
- if (modPtr->flags & DOUBLE) {
- count = 2;
- } else {
- count = 3;
- }
+ if (modPtr->flags & (MULT_CLICKS)) {
+ int i = modPtr->flags & MULT_CLICKS;
+ count = 2;
+ while (i >>= 1) count++;
}
while ((*p == '-') || isspace(UCHAR(*p))) {
p++;
@@ -4014,7 +4182,8 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
}
}
} else if (eventFlags == 0) {
- interp->result = "no event type or button # or keysym";
+ Tcl_SetResult(interp, "no event type or button # or keysym",
+ TCL_STATIC);
return 0;
}
@@ -4025,11 +4194,13 @@ ParseEventDescription(interp, eventStringPtr, patPtr,
while (*p != '\0') {
p++;
if (*p == '>') {
- interp->result = "extra characters after detail in binding";
+ Tcl_SetResult(interp,
+ "extra characters after detail in binding",
+ TCL_STATIC);
return 0;
}
}
- interp->result = "missing \">\" in binding";
+ Tcl_SetResult(interp, "missing \">\" in binding", TCL_STATIC);
return 0;
}
p++;
@@ -4104,7 +4275,7 @@ GetPatternString(psPtr, dsPtr)
Tcl_DString *dsPtr;
{
Pattern *patPtr;
- char c, buffer[10];
+ char c, buffer[TCL_INTEGER_SPACE];
int patsLeft, needMods;
ModInfo *modPtr;
EventInfo *eiPtr;
@@ -4147,8 +4318,8 @@ GetPatternString(psPtr, dsPtr)
/*
* It's a more general event specification. First check
- * for "Double" or "Triple", then modifiers, then event type,
- * then keysym or button detail.
+ * for "Double", "Triple", "Quadruple", then modifiers,
+ * then event type, then keysym or button detail.
*/
Tcl_DStringAppend(dsPtr, "<", 1);
@@ -4161,7 +4332,14 @@ GetPatternString(psPtr, dsPtr)
(char *) (patPtr-1), sizeof(Pattern)) == 0)) {
patsLeft--;
patPtr--;
- Tcl_DStringAppend(dsPtr, "Triple-", 7);
+ 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);
}
@@ -4203,220 +4381,6 @@ GetPatternString(psPtr, dsPtr)
}
/*
- *----------------------------------------------------------------------
- *
- * GetKeySym --
- *
- * Given an X KeyPress or KeyRelease event, map the
- * keycode in the event into a KeySym.
- *
- * Results:
- * The return value is the KeySym corresponding to
- * eventPtr, or NoSymbol if no matching Keysym could be
- * found.
- *
- * Side effects:
- * In the first call for a given display, keycode-to-
- * KeySym maps get loaded.
- *
- *----------------------------------------------------------------------
- */
-
-static KeySym
-GetKeySym(dispPtr, eventPtr)
- TkDisplay *dispPtr; /* Display in which to
- * map keycode. */
- XEvent *eventPtr; /* Description of X event. */
-{
- KeySym sym;
- int index;
-
- /*
- * Refresh the mapping information if it's stale
- */
-
- if (dispPtr->bindInfoStale) {
- InitKeymapInfo(dispPtr);
- }
-
- /*
- * Figure out which of the four slots in the keymap vector to
- * use for this key. Refer to Xlib documentation for more info
- * on how this computation works.
- */
-
- index = 0;
- if (eventPtr->xkey.state & dispPtr->modeModMask) {
- index = 2;
- }
- if ((eventPtr->xkey.state & ShiftMask)
- || ((dispPtr->lockUsage != LU_IGNORE)
- && (eventPtr->xkey.state & LockMask))) {
- index += 1;
- }
- sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
-
- /*
- * Special handling: if the key was shifted because of Lock, but
- * lock is only caps lock, not shift lock, and the shifted keysym
- * isn't upper-case alphabetic, then switch back to the unshifted
- * keysym.
- */
-
- if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
- && (dispPtr->lockUsage == LU_CAPS)) {
- if (!(((sym >= XK_A) && (sym <= XK_Z))
- || ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
- || ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
- index &= ~1;
- sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
- index);
- }
- }
-
- /*
- * Another bit of special handling: if this is a shifted key and there
- * is no keysym defined, then use the keysym for the unshifted key.
- */
-
- if ((index & 1) && (sym == NoSymbol)) {
- sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
- index & ~1);
- }
- return sym;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * InitKeymapInfo --
- *
- * This procedure is invoked to scan keymap information
- * to recompute stuff that's important for binding, such
- * as the modifier key (if any) that corresponds to "mode
- * switch".
- *
- * Results:
- * None.
- *
- * Side effects:
- * Keymap-related information in dispPtr is updated.
- *
- *--------------------------------------------------------------
- */
-
-static void
-InitKeymapInfo(dispPtr)
- TkDisplay *dispPtr; /* Display for which to recompute keymap
- * information. */
-{
- XModifierKeymap *modMapPtr;
- KeyCode *codePtr;
- KeySym keysym;
- int count, i, j, max, arraySize;
-#define KEYCODE_ARRAY_SIZE 20
-
- dispPtr->bindInfoStale = 0;
- modMapPtr = XGetModifierMapping(dispPtr->display);
-
- /*
- * Check the keycodes associated with the Lock modifier. If
- * any of them is associated with the XK_Shift_Lock modifier,
- * then Lock has to be interpreted as Shift Lock, not Caps Lock.
- */
-
- dispPtr->lockUsage = LU_IGNORE;
- codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
- for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
- if (*codePtr == 0) {
- continue;
- }
- keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
- if (keysym == XK_Shift_Lock) {
- dispPtr->lockUsage = LU_SHIFT;
- break;
- }
- if (keysym == XK_Caps_Lock) {
- dispPtr->lockUsage = LU_CAPS;
- break;
- }
- }
-
- /*
- * Look through the keycodes associated with modifiers to see if
- * the the "mode switch", "meta", or "alt" keysyms are associated
- * with any modifiers. If so, remember their modifier mask bits.
- */
-
- dispPtr->modeModMask = 0;
- dispPtr->metaModMask = 0;
- dispPtr->altModMask = 0;
- codePtr = modMapPtr->modifiermap;
- max = 8*modMapPtr->max_keypermod;
- for (i = 0; i < max; i++, codePtr++) {
- if (*codePtr == 0) {
- continue;
- }
- keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
- if (keysym == XK_Mode_switch) {
- dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
- }
- if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
- dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
- }
- if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
- dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
- }
- }
-
- /*
- * Create an array of the keycodes for all modifier keys.
- */
-
- if (dispPtr->modKeyCodes != NULL) {
- ckfree((char *) dispPtr->modKeyCodes);
- }
- dispPtr->numModKeyCodes = 0;
- arraySize = KEYCODE_ARRAY_SIZE;
- dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
- (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
- for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
- if (*codePtr == 0) {
- continue;
- }
-
- /*
- * Make sure that the keycode isn't already in the array.
- */
-
- for (j = 0; j < dispPtr->numModKeyCodes; j++) {
- if (dispPtr->modKeyCodes[j] == *codePtr) {
- goto nextModCode;
- }
- }
- if (dispPtr->numModKeyCodes >= arraySize) {
- KeyCode *new;
-
- /*
- * Ran out of space in the array; grow it.
- */
-
- arraySize *= 2;
- new = (KeyCode *) ckalloc((unsigned)
- (arraySize * sizeof(KeyCode)));
- memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
- (dispPtr->numModKeyCodes * sizeof(KeyCode)));
- ckfree((char *) dispPtr->modKeyCodes);
- dispPtr->modKeyCodes = new;
- }
- dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
- dispPtr->numModKeyCodes++;
- nextModCode: continue;
- }
- XFreeModifiermap(modMapPtr);
-}
-
-/*
*---------------------------------------------------------------------------
*
* EvalTclBinding --
@@ -4525,7 +4489,7 @@ TkKeysymToString(keysym)
*
* Results:
* Returns the result of evaluating script, including both a standard
- * Tcl completion code and a string in interp->result.
+ * Tcl completion code and a string in the interp's result.
*
* Side effects:
* None.
@@ -4550,3 +4514,5 @@ TkCopyAndGlobalEval(interp, script)
}
+
+
diff --git a/tk/generic/tkBitmap.c b/tk/generic/tkBitmap.c
index 431fa56db42..ff8e7e3e5a2 100644
--- a/tk/generic/tkBitmap.c
+++ b/tk/generic/tkBitmap.c
@@ -6,7 +6,7 @@
* also avoids interactions with the X server.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -51,69 +51,180 @@
* "nameTable".
*/
-typedef struct {
+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 refCount; /* Number of active uses of bitmap. */
- Tcl_HashEntry *hashPtr; /* Entry in nameTable for this structure
+ int resourceRefCount; /* Number of active uses of this bitmap (each
+ * active use corresponds to a call to
+ * Tk_AllocBitmapFromObj or Tk_GetBitmap).
+ * If this count is 0, then this TkBitmap
+ * structure is no longer valid and it isn't
+ * present in nameTable: it is being kept
+ * around only because there are objects
+ * referring to it. The structure is freed
+ * when resourceRefCount and objRefCount
+ * are both 0. */
+ int objRefCount; /* Number of Tcl_Obj's that reference
+ * this structure. */
+ Tcl_HashEntry *nameHashPtr; /* Entry in nameTable for this structure
+ * (needed when deleting). */
+ Tcl_HashEntry *idHashPtr; /* Entry in idTable for this structure
* (needed when deleting). */
+ struct TkBitmap *nextPtr; /* Points to the next TkBitmap structure with
+ * the same name. All bitmaps with the
+ * same name (but different displays) are
+ * chained together off a single entry in
+ * nameTable. */
} TkBitmap;
-/*
- * Hash table to map from a textual description of a bitmap to the
- * TkBitmap record for the bitmap, and key structure used in that
- * hash table:
+/*
+ * Used in bitmapDataTable, stored in the TkDisplay structure, to map
+ * between in-core data about a bitmap to its TkBitmap structure.
*/
-static Tcl_HashTable nameTable;
typedef struct {
- Tk_Uid name; /* Textual name for desired bitmap. */
- Screen *screen; /* Screen on which bitmap will be used. */
-} NameKey;
+ 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;
/*
- * Hash table that maps from <display + bitmap id> to the TkBitmap structure
- * for the bitmap. This table is used by Tk_FreeBitmap.
+ * Forward declarations for procedures defined in this file:
*/
-static Tcl_HashTable idTable;
-typedef struct {
- Display *display; /* Display for which bitmap was allocated. */
- Pixmap pixmap; /* X identifier for pixmap. */
-} IdKey;
+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));
/*
- * Hash table create by Tk_DefineBitmap to map from a name to a
- * collection of in-core data about a bitmap. The table is
- * indexed by the address of the data for the bitmap, and the entries
- * contain pointers to TkPredefBitmap structures.
+ * 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_HashTable tkPredefBitmapTable;
-
+static Tcl_ObjType bitmapObjType = {
+ "bitmap", /* name */
+ FreeBitmapObjProc, /* freeIntRepProc */
+ DupBitmapObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
/*
- * Hash table used by Tk_GetBitmapFromData to map from a collection
- * of in-core data about a bitmap to a Tk_Uid giving an automatically-
- * generated name for the bitmap:
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
*/
-static Tcl_HashTable dataTable;
-typedef struct {
- char *source; /* Bitmap bits. */
- int width, height; /* Dimensions of bitmap. */
-} DataKey;
+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;
-static int initialized = 0; /* 0 means static structures haven't been
- * initialized yet. */
+ if (objPtr->typePtr != &bitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+ bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
-/*
- * Forward declarations for procedures defined in this file:
- */
+ /*
+ * If the object currently points to a TkBitmap, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (bitmapPtr != NULL) {
+ if (bitmapPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkBitmap that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeBitmapObjProc(objPtr);
+ bitmapPtr = NULL;
+ } else if (Tk_Display(tkwin) == bitmapPtr->display) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr->bitmap;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkBitmap that we wanted. Search
+ * the list of TkBitmaps with the same name to see if one of the
+ * others is the right one.
+ */
+
+ if (bitmapPtr != NULL) {
+ TkBitmap *firstBitmapPtr =
+ (TkBitmap *) Tcl_GetHashValue(bitmapPtr->nameHashPtr);
+ FreeBitmapObjProc(objPtr);
+ for (bitmapPtr = firstBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if (Tk_Display(tkwin) == bitmapPtr->display) {
+ bitmapPtr->resourceRefCount++;
+ bitmapPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ return bitmapPtr->bitmap;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetBitmap to allocate a new TkBitmap object.
+ */
-static void BitmapInit _ANSI_ARGS_((void));
+ bitmapPtr = GetBitmap(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ if (bitmapPtr == NULL) {
+ return None;
+ }
+ bitmapPtr->objRefCount++;
+ return bitmapPtr->bitmap;
+}
/*
*----------------------------------------------------------------------
@@ -127,7 +238,7 @@ static void BitmapInit _ANSI_ARGS_((void));
* The return value is the X identifer for the desired bitmap
* (i.e. a Pixmap with a single plane), unless string couldn't be
* parsed correctly. In this case, None is returned and an error
- * message is left in interp->result. The caller should never
+ * 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.
*
@@ -145,30 +256,78 @@ Tk_GetBitmap(interp, tkwin, string)
Tcl_Interp *interp; /* Interpreter to use for error reporting,
* this may be NULL. */
Tk_Window tkwin; /* Window in which bitmap will be used. */
- Tk_Uid string; /* Description of bitmap. See manual entry
+ 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. */
{
- NameKey nameKey;
- IdKey idKey;
- Tcl_HashEntry *nameHashPtr, *idHashPtr, *predefHashPtr;
- register TkBitmap *bitmapPtr;
+ 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 (!initialized) {
- BitmapInit();
+ if (!dispPtr->bitmapInit) {
+ BitmapInit(dispPtr);
}
- nameKey.name = string;
- nameKey.screen = Tk_Screen(tkwin);
- nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string, &new);
if (!new) {
- bitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);
- bitmapPtr->refCount++;
- return bitmapPtr->bitmap;
+ existingBitmapPtr = (TkBitmap *) Tcl_GetHashValue(nameHashPtr);
+ for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL;
+ bitmapPtr = bitmapPtr->nextPtr) {
+ if (Tk_Display(tkwin) == bitmapPtr->display) {
+ bitmapPtr->resourceRefCount++;
+ return bitmapPtr;
+ }
+ }
+ } else {
+ existingBitmapPtr = NULL;
}
/*
@@ -179,7 +338,7 @@ Tk_GetBitmap(interp, tkwin, string)
* defined by a call to Tk_DefineBitmap.
*/
- if (*string == '@') {
+ if (*string == '@') { /* INTL: ISO char */
Tcl_DString buffer;
int result;
@@ -188,13 +347,19 @@ Tk_GetBitmap(interp, tkwin, string)
" safe interpreter", (char *) NULL);
goto error;
}
-
- string = Tcl_TranslateFileName(interp, string + 1, &buffer);
+
+ /*
+ * 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(nameKey.screen), string,
+ RootWindowOfScreen(Tk_Screen(tkwin)), string,
(unsigned int *) &width, (unsigned int *) &height,
&bitmap, &dummy2, &dummy2);
if (result != BitmapSuccess) {
@@ -207,7 +372,8 @@ Tk_GetBitmap(interp, tkwin, string)
}
Tcl_DStringFree(&buffer);
} else {
- predefHashPtr = Tcl_FindHashEntry(&tkPredefBitmapTable, string);
+ predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable,
+ string);
if (predefHashPtr == NULL) {
/*
* The following platform specific call allows the user to
@@ -236,7 +402,8 @@ Tk_GetBitmap(interp, tkwin, string)
}
} else {
bitmap = XCreateBitmapFromData(Tk_Display(tkwin),
- RootWindowOfScreen(nameKey.screen), predefPtr->source,
+ RootWindowOfScreen(Tk_Screen(tkwin)),
+ predefPtr->source,
(unsigned) width, (unsigned) height);
}
}
@@ -251,22 +418,24 @@ Tk_GetBitmap(interp, tkwin, string)
bitmapPtr->width = width;
bitmapPtr->height = height;
bitmapPtr->display = Tk_Display(tkwin);
- bitmapPtr->refCount = 1;
- bitmapPtr->hashPtr = nameHashPtr;
- idKey.display = bitmapPtr->display;
- idKey.pixmap = bitmap;
- idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey,
- &new);
+ 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(idHashPtr, bitmapPtr);
- return bitmapPtr->bitmap;
+ Tcl_SetHashValue(bitmapPtr->idHashPtr, bitmapPtr);
+ return bitmapPtr;
error:
- Tcl_DeleteHashEntry(nameHashPtr);
- return None;
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
}
/*
@@ -280,7 +449,7 @@ Tk_GetBitmap(interp, tkwin, string)
*
* Results:
* A standard Tcl result. If an error occurs then TCL_ERROR is
- * returned and a message is left in interp->result.
+ * 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
@@ -292,7 +461,7 @@ Tk_GetBitmap(interp, tkwin, string)
int
Tk_DefineBitmap(interp, name, source, width, height)
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- Tk_Uid name; /* Name to use for bitmap. Must not already
+ CONST char *name; /* Name to use for bitmap. Must not already
* be defined as a bitmap. */
char *source; /* Address of bits for bitmap. */
int width; /* Width of bitmap. */
@@ -301,12 +470,23 @@ Tk_DefineBitmap(interp, name, source, width, height)
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 (!initialized) {
- BitmapInit();
+ if (!tsdPtr->initialized) {
+ BitmapInit((TkDisplay *) NULL);
}
- predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new);
+ predefHashPtr = Tcl_CreateHashEntry(&tsdPtr->predefBitmapTable,
+ name, &new);
if (!new) {
Tcl_AppendResult(interp, "bitmap \"", name,
"\" is already defined", (char *) NULL);
@@ -338,29 +518,27 @@ Tk_DefineBitmap(interp, name, source, width, height)
*--------------------------------------------------------------
*/
-Tk_Uid
+char *
Tk_NameOfBitmap(display, bitmap)
Display *display; /* Display for which bitmap was
* allocated. */
Pixmap bitmap; /* Bitmap whose name is wanted. */
{
- IdKey idKey;
Tcl_HashEntry *idHashPtr;
TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
- if (!initialized) {
+ if (dispPtr == NULL || !dispPtr->bitmapInit) {
unknown:
panic("Tk_NameOfBitmap received unknown bitmap argument");
}
- idKey.display = display;
- idKey.pixmap = bitmap;
- idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
if (idHashPtr == NULL) {
goto unknown;
}
bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
- return ((NameKey *) bitmapPtr->hashPtr->key.words)->name;
+ return bitmapPtr->nameHashPtr->key.string;
}
/*
@@ -390,18 +568,16 @@ Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr)
int *widthPtr; /* Store bitmap width here. */
int *heightPtr; /* Store bitmap height here. */
{
- IdKey idKey;
Tcl_HashEntry *idHashPtr;
TkBitmap *bitmapPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
- if (!initialized) {
+ if (!dispPtr->bitmapInit) {
unknownBitmap:
panic("Tk_SizeOfBitmap received unknown bitmap argument");
}
- idKey.display = display;
- idKey.pixmap = bitmap;
- idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
if (idHashPtr == NULL) {
goto unknownBitmap;
}
@@ -413,6 +589,56 @@ Tk_SizeOfBitmap(display, bitmap, widthPtr, heightPtr)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -435,26 +661,115 @@ Tk_FreeBitmap(display, bitmap)
Pixmap bitmap; /* Bitmap to be released. */
{
Tcl_HashEntry *idHashPtr;
- register TkBitmap *bitmapPtr;
- IdKey idKey;
+ TkDisplay *dispPtr = TkGetDisplay(display);
- if (!initialized) {
+ if (!dispPtr->bitmapInit) {
panic("Tk_FreeBitmap called before Tk_GetBitmap");
}
- idKey.display = display;
- idKey.pixmap = bitmap;
- idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->bitmapIdTable, (char *) bitmap);
if (idHashPtr == NULL) {
panic("Tk_FreeBitmap received unknown bitmap argument");
}
- bitmapPtr = (TkBitmap *) Tcl_GetHashValue(idHashPtr);
- bitmapPtr->refCount--;
- if (bitmapPtr->refCount == 0) {
- Tk_FreePixmap(bitmapPtr->display, bitmapPtr->bitmap);
- Tcl_DeleteHashEntry(idHashPtr);
- Tcl_DeleteHashEntry(bitmapPtr->hashPtr);
- ckfree((char *) bitmapPtr);
+ 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++;
}
}
@@ -471,7 +786,7 @@ Tk_FreeBitmap(display, bitmap)
* The return value is the X identifer for the desired bitmap
* (a one-plane Pixmap), unless it couldn't be created properly.
* In this case, None is returned and an error message is left in
- * interp->result. The caller should never modify the bitmap that
+ * 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.
*
@@ -494,25 +809,24 @@ Tk_GetBitmapFromData(interp, tkwin, source, width, height)
{
DataKey nameKey;
Tcl_HashEntry *dataHashPtr;
- Tk_Uid name;
int new;
- char string[20];
- static int autoNumber = 0;
+ char string[16 + TCL_INTEGER_SPACE];
+ char *name;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- BitmapInit();
- }
+ BitmapInit(dispPtr);
nameKey.source = source;
nameKey.width = width;
nameKey.height = height;
- dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &nameKey, &new);
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapDataTable,
+ (char *) &nameKey, &new);
if (!new) {
- name = (Tk_Uid) Tcl_GetHashValue(dataHashPtr);
+ name = (char *) Tcl_GetHashValue(dataHashPtr);
} else {
- autoNumber++;
- sprintf(string, "_tk%d", autoNumber);
- name = Tk_GetUid(string);
+ 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);
@@ -525,63 +839,226 @@ Tk_GetBitmapFromData(interp, tkwin, source, width, height)
/*
*----------------------------------------------------------------------
*
- * BitmapInit --
+ * 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.
*
- * Initialize the structures used for bitmap management.
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+{
+ TkBitmap *bitmapPtr = GetBitmapFromObj(tkwin, objPtr);
+ return bitmapPtr->bitmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetBitmapFromObj --
+ *
+ * Returns the bitmap referred to by a Tcl object. The bitmap must
+ * already have been allocated via a call to Tk_AllocBitmapFromObj
+ * or Tk_GetBitmap.
+ *
+ * Results:
+ * Returns the TkBitmap * that matches the tkwin and the string rep
+ * of objPtr.
+ *
+ * Side effects:
+ * If the object is not already a bitmap, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkBitmap *
+GetBitmapFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* Window in which the bitmap will be used. */
+ Tcl_Obj *objPtr; /* The object that describes the desired
+ * bitmap. */
+{
+ TkBitmap *bitmapPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ if (objPtr->typePtr != &bitmapObjType) {
+ InitBitmapObj(objPtr);
+ }
+
+ bitmapPtr = (TkBitmap *) objPtr->internalRep.twoPtrValue.ptr1;
+ if (bitmapPtr != NULL) {
+ if ((bitmapPtr->resourceRefCount > 0)
+ && (Tk_Display(tkwin) == bitmapPtr->display)) {
+ return bitmapPtr;
+ }
+ hashPtr = bitmapPtr->nameHashPtr;
+ FreeBitmapObjProc(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&dispPtr->bitmapNameTable,
+ Tcl_GetString(objPtr));
+ if (hashPtr == NULL) {
+ goto error;
+ }
+ }
+
+ /*
+ * At this point we've got a hash table entry, off of which hang
+ * one or more TkBitmap structures. See if any of them will work.
+ */
+
+ for (bitmapPtr = (TkBitmap *) Tcl_GetHashValue(hashPtr);
+ bitmapPtr != NULL; bitmapPtr = bitmapPtr->nextPtr) {
+ if (Tk_Display(tkwin) == bitmapPtr->display) {
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) bitmapPtr;
+ bitmapPtr->objRefCount++;
+ return bitmapPtr;
+ }
+ }
+
+ error:
+ panic("GetBitmapFromObj called with non-existent bitmap!");
+ /*
+ * The following code isn't reached; it's just there to please compilers.
+ */
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBitmapObj --
+ *
+ * Bookeeping procedure to change an objPtr to a bitmap type.
*
* Results:
* None.
*
* Side effects:
+ * The old internal rep of the object is freed. The internal
+ * rep is cleared. The final form of the object is set
+ * by either Tk_AllocBitmapFromObj or GetBitmapFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitBitmapObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &bitmapObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BitmapInit --
+ * Initializes hash tables used by this module. Initializes
+ * tables stored in TkDisplay structure if a TkDisplay pointer
+ * is passed in. Iinitializes the thread-local data
+ * in the current thread's ThreadSpecificData structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
* Read the code.
*
*----------------------------------------------------------------------
*/
static void
-BitmapInit()
+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));
- dummy = Tcl_CreateInterp();
- initialized = 1;
- Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
- Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int));
- Tcl_InitHashTable(&tkPredefBitmapTable, TCL_ONE_WORD_KEYS);
+ /*
+ * 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);
+ }
/*
- * The call below is tricky: can't use sizeof(IdKey) because it
- * gets padded with extra unpredictable bytes on some 64-bit
- * machines.
+ * Was a valid TkDisplay pointer passed? If so, initialize the
+ * Bitmap module tables in that structure.
*/
- Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Pixmap))
- /sizeof(int));
-
- Tk_DefineBitmap(dummy, Tk_GetUid("error"), (char *) error_bits,
- error_width, error_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("gray75"), (char *) gray75_bits,
- gray75_width, gray75_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("gray50"), (char *) gray50_bits,
- gray50_width, gray50_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("gray25"), (char *) gray25_bits,
- gray25_width, gray25_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("gray12"), (char *) gray12_bits,
- gray12_width, gray12_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("hourglass"), (char *) hourglass_bits,
- hourglass_width, hourglass_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("info"), (char *) info_bits,
- info_width, info_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("questhead"), (char *) questhead_bits,
- questhead_width, questhead_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("question"), (char *) question_bits,
- question_width, question_height);
- Tk_DefineBitmap(dummy, Tk_GetUid("warning"), (char *) warning_bits,
- warning_width, warning_height);
-
- TkpDefineNativeBitmaps();
-
- Tcl_DeleteInterp(dummy);
+ 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);
+ }
}
/*
@@ -627,4 +1104,83 @@ TkReadBitmapFile(display, d, filename, 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/tk/generic/tkButton.c b/tk/generic/tkButton.c
index b493be03a0c..8a52f91217c 100644
--- a/tk/generic/tkButton.c
+++ b/tk/generic/tkButton.c
@@ -3,11 +3,10 @@
*
* This module implements a collection of button-like
* widgets for the Tk toolkit. The widgets implemented
- * include labels, buttons, check buttons, and radio
- * buttons.
+ * include labels, buttons, checkbuttons, and radiobuttons.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -19,183 +18,446 @@
#include "default.h"
/*
- * Class names for buttons, indexed by one of the type values above.
+ * Class names for buttons, indexed by one of the type values defined
+ * in tkButton.h.
*/
static char *classNames[] = {"Label", "Button", "Checkbutton", "Radiobutton"};
/*
- * The class procedure table for the button widget.
+ * The following table defines the legal values for the -default option.
+ * It is used together with the "enum defaultValue" declaration in tkButton.h.
*/
-static int configFlags[] = {LABEL_MASK, BUTTON_MASK,
- CHECK_BUTTON_MASK, RADIO_BUTTON_MASK};
+static char *defaultStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -state option.
+ * It is used together with the "enum state" declaration in tkButton.h.
+ */
+
+static char *stateStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
/*
- * Information used for parsing configuration specs:
+ * Information used for parsing configuration options. There is a
+ * separate table for each of the four widget classes.
*/
-Tk_ConfigSpec tkpButtonConfigSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_BUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkButton, activeBorder),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
- |TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_BUTTON_ACTIVE_BG_MONO, Tk_Offset(TkButton, activeBorder),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
- |TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_BUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg),
- BUTTON_MASK|TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_CHKRAD_ACTIVE_FG_COLOR, Tk_Offset(TkButton, activeFg),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_BUTTON_ACTIVE_FG_MONO, Tk_Offset(TkButton, activeFg),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK
- |TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
- DEF_BUTTON_ANCHOR, Tk_Offset(TkButton, anchor), ALL_MASK},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_BUTTON_BG_COLOR, Tk_Offset(TkButton, normalBorder),
- ALL_MASK | TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_BUTTON_BG_MONO, Tk_Offset(TkButton, normalBorder),
- ALL_MASK | TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, ALL_MASK},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, ALL_MASK},
- {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
- DEF_BUTTON_BITMAP, Tk_Offset(TkButton, bitmap),
- ALL_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidth), ALL_MASK},
- {TK_CONFIG_STRING, "-command", "command", "Command",
- DEF_BUTTON_COMMAND, Tk_Offset(TkButton, command),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_BUTTON_CURSOR, Tk_Offset(TkButton, cursor),
- ALL_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-default", "default", "Default",
- DEF_BUTTON_DEFAULT, Tk_Offset(TkButton, defaultState), BUTTON_MASK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+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_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_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-default", "default", "Default",
+ DEF_BUTTON_DEFAULT, -1, Tk_Offset(TkButton, defaultState),
+ 0, (ClientData) defaultStrings, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_BUTTON_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_BUTTON_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_BUTTON_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_BUTTON_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+static Tk_OptionSpec checkbuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
"DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
- Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK
- |RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
- "DisabledForeground", DEF_BUTTON_DISABLED_FG_MONO,
- Tk_Offset(TkButton, disabledFg), BUTTON_MASK|CHECK_BUTTON_MASK
- |RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, ALL_MASK},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_BUTTON_FONT, Tk_Offset(TkButton, tkfont),
- ALL_MASK},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_BUTTON_FG, Tk_Offset(TkButton, normalFg), LABEL_MASK|BUTTON_MASK},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_CHKRAD_FG, Tk_Offset(TkButton, normalFg), CHECK_BUTTON_MASK
- |RADIO_BUTTON_MASK},
- {TK_CONFIG_STRING, "-height", "height", "Height",
- DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightString), ALL_MASK},
- {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
- "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG,
- Tk_Offset(TkButton, highlightBorder), ALL_MASK},
- {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
- DEF_BUTTON_HIGHLIGHT, Tk_Offset(TkButton, highlightColorPtr),
- ALL_MASK},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
- "HighlightThickness",
- DEF_LABEL_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth),
- LABEL_MASK},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
- "HighlightThickness",
- DEF_BUTTON_HIGHLIGHT_WIDTH, Tk_Offset(TkButton, highlightWidth),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
- {TK_CONFIG_STRING, "-image", "image", "Image",
- DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imageString),
- ALL_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
- DEF_BUTTON_INDICATOR, Tk_Offset(TkButton, indicatorOn),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
- {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
- DEF_BUTTON_JUSTIFY, Tk_Offset(TkButton, justify), ALL_MASK},
- {TK_CONFIG_STRING, "-offvalue", "offValue", "Value",
- DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValue),
- CHECK_BUTTON_MASK},
- {TK_CONFIG_STRING, "-onvalue", "onValue", "Value",
- DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValue),
- CHECK_BUTTON_MASK},
- {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
- DEF_BUTTON_PADX, Tk_Offset(TkButton, padX), BUTTON_MASK},
- {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
- DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padX),
- LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
- {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
- DEF_BUTTON_PADY, Tk_Offset(TkButton, padY), BUTTON_MASK},
- {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
- DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padY),
- LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_BUTTON_RELIEF, Tk_Offset(TkButton, relief), BUTTON_MASK},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_LABCHKRAD_RELIEF, Tk_Offset(TkButton, relief),
- LABEL_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
- {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background",
- DEF_BUTTON_SELECT_COLOR, Tk_Offset(TkButton, selectBorder),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_COLOR_ONLY
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BORDER, "-selectcolor", "selectColor", "Background",
- DEF_BUTTON_SELECT_MONO, Tk_Offset(TkButton, selectBorder),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_MONO_ONLY
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-selectimage", "selectImage", "SelectImage",
- DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImageString),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-state", "state", "State",
- DEF_BUTTON_STATE, Tk_Offset(TkButton, state),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_LABEL_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus),
- LABEL_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocus),
- BUTTON_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-text", "text", "Text",
- DEF_BUTTON_TEXT, Tk_Offset(TkButton, text), ALL_MASK},
- {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
- DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarName),
- ALL_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_INT, "-underline", "underline", "Underline",
- DEF_BUTTON_UNDERLINE, Tk_Offset(TkButton, underline), ALL_MASK},
- {TK_CONFIG_STRING, "-value", "value", "Value",
- DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValue),
- RADIO_BUTTON_MASK},
- {TK_CONFIG_STRING, "-variable", "variable", "Variable",
- DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName),
- RADIO_BUTTON_MASK},
- {TK_CONFIG_STRING, "-variable", "variable", "Variable",
- DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarName),
- CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-width", "width", "Width",
- DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthString), ALL_MASK},
- {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
- DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLength), ALL_MASK},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn), 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_STRING, "-offvalue", "offValue", "Value",
+ DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-onvalue", "onValue", "Value",
+ DEF_BUTTON_ON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_CHECKBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+static Tk_OptionSpec radiobuttonOptionSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_BUTTON_ACTIVE_BG_COLOR, -1, Tk_Offset(TkButton, activeBorder),
+ 0, (ClientData) DEF_BUTTON_ACTIVE_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-activeforeground", "activeForeground", "Background",
+ DEF_CHKRAD_ACTIVE_FG_COLOR, -1, Tk_Offset(TkButton, activeFg),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_ACTIVE_FG_MONO, 0},
+ {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_BUTTON_ANCHOR, -1, Tk_Offset(TkButton, anchor), 0, 0, 0},
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_BUTTON_BG_COLOR, -1, Tk_Offset(TkButton, normalBorder),
+ 0, (ClientData) DEF_BUTTON_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_BUTTON_BITMAP, -1, Tk_Offset(TkButton, bitmap),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_BUTTON_BORDER_WIDTH, Tk_Offset(TkButton, borderWidthPtr),
+ Tk_Offset(TkButton, borderWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-command", "command", "Command",
+ DEF_BUTTON_COMMAND, Tk_Offset(TkButton, commandPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_BUTTON_CURSOR, -1, Tk_Offset(TkButton, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_BUTTON_DISABLED_FG_COLOR,
+ -1, Tk_Offset(TkButton, disabledFg), TK_OPTION_NULL_OK,
+ (ClientData) DEF_BUTTON_DISABLED_FG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_BUTTON_FONT, -1, Tk_Offset(TkButton, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CHKRAD_FG, -1, Tk_Offset(TkButton, normalFg), 0, 0, 0},
+ {TK_OPTION_STRING, "-height", "height", "Height",
+ DEF_BUTTON_HEIGHT, Tk_Offset(TkButton, heightPtr), -1, 0, 0, 0},
+ {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_BUTTON_HIGHLIGHT_BG_COLOR,
+ -1, Tk_Offset(TkButton, highlightBorder), 0,
+ (ClientData) DEF_BUTTON_HIGHLIGHT_BG_MONO, 0},
+ {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_BUTTON_HIGHLIGHT, -1, Tk_Offset(TkButton, highlightColorPtr),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", DEF_BUTTON_HIGHLIGHT_WIDTH,
+ Tk_Offset(TkButton, highlightWidthPtr),
+ Tk_Offset(TkButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_BUTTON_IMAGE, Tk_Offset(TkButton, imagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_BUTTON_INDICATOR, -1, Tk_Offset(TkButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkButton, justify), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_LABCHKRAD_PADX, Tk_Offset(TkButton, padXPtr),
+ Tk_Offset(TkButton, padX), 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_LABCHKRAD_PADY, Tk_Offset(TkButton, padYPtr),
+ Tk_Offset(TkButton, padY), 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_LABCHKRAD_RELIEF, -1, Tk_Offset(TkButton, relief), 0, 0, 0},
+ {TK_OPTION_BORDER, "-selectcolor", "selectColor", "Background",
+ DEF_BUTTON_SELECT_COLOR, -1, Tk_Offset(TkButton, selectBorder),
+ TK_OPTION_NULL_OK, (ClientData) DEF_BUTTON_SELECT_MONO, 0},
+ {TK_OPTION_STRING, "-selectimage", "selectImage", "SelectImage",
+ DEF_BUTTON_SELECT_IMAGE, Tk_Offset(TkButton, selectImagePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_BUTTON_STATE, -1, Tk_Offset(TkButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_BUTTON_TAKE_FOCUS, Tk_Offset(TkButton, takeFocusPtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_BUTTON_TEXT, Tk_Offset(TkButton, textPtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_BUTTON_TEXT_VARIABLE, Tk_Offset(TkButton, textVarNamePtr), -1,
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_BUTTON_UNDERLINE, -1, Tk_Offset(TkButton, underline), 0, 0, 0},
+ {TK_OPTION_STRING, "-value", "value", "Value",
+ DEF_BUTTON_VALUE, Tk_Offset(TkButton, onValuePtr), -1, 0, 0, 0},
+ {TK_OPTION_STRING, "-variable", "variable", "Variable",
+ DEF_RADIOBUTTON_VARIABLE, Tk_Offset(TkButton, selVarNamePtr), -1,
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_BUTTON_WIDTH, Tk_Offset(TkButton, widthPtr), -1, 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_BUTTON_WRAP_LENGTH, Tk_Offset(TkButton, wrapLengthPtr),
+ Tk_Offset(TkButton, wrapLength), 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, 0, 0}
+};
+
+/*
+ * The following table maps from one of the type values defined in
+ * tkButton.h, such as TYPE_LABEL, to the option template for that
+ * class of widgets.
+ */
+
+static Tk_OptionSpec *optionSpecs[] = {
+ labelOptionSpecs,
+ buttonOptionSpecs,
+ checkbuttonOptionSpecs,
+ radiobuttonOptionSpecs
};
/*
- * String to print out in error messages, identifying options for
- * widget commands for different types of labels or buttons:
+ * The following tables define the widget commands supported by
+ * each of the classes, and map the indexes into the string tables
+ * into a single enumerated type used to dispatch the widget command.
*/
-static char *optionStrings[] = {
- "cget or configure",
- "cget, configure, flash, or invoke",
- "cget, configure, deselect, flash, invoke, select, or toggle",
- "cget, configure, deselect, flash, invoke, or select"
+static char *commandNames[][8] = {
+ {"cget", "configure", (char *) NULL},
+ {"cget", "configure", "flash", "invoke", (char *) NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ "toggle", (char *) NULL},
+ {"cget", "configure", "deselect", "flash", "invoke", "select",
+ (char *) NULL}
+};
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE
+};
+static enum command map[][8] = {
+ {COMMAND_CGET, COMMAND_CONFIGURE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_FLASH, COMMAND_INVOKE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT, COMMAND_TOGGLE},
+ {COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DESELECT, COMMAND_FLASH,
+ COMMAND_INVOKE, COMMAND_SELECT}
};
/*
@@ -205,8 +467,8 @@ static char *optionStrings[] = {
static void ButtonCmdDeletedProc _ANSI_ARGS_((
ClientData clientData));
static int ButtonCreate _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv,
- int type));
+ 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,
@@ -221,13 +483,13 @@ static char * ButtonTextVarProc _ANSI_ARGS_((ClientData clientData,
static char * ButtonVarProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-static int ButtonWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int 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 argc, char **argv,
- int flags));
+ TkButton *butPtr, int objc,
+ Tcl_Obj *CONST objv[]));
static void DestroyButton _ANSI_ARGS_((TkButton *butPtr));
-
/*
*--------------------------------------------------------------
@@ -249,47 +511,43 @@ static void DestroyButton _ANSI_ARGS_((TkButton *butPtr));
*/
int
-Tk_ButtonCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_ButtonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- return ButtonCreate(clientData, interp, argc, argv, TYPE_BUTTON);
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_BUTTON);
}
int
-Tk_CheckbuttonCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_CheckbuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- return ButtonCreate(clientData, interp, argc, argv, TYPE_CHECK_BUTTON);
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_CHECK_BUTTON);
}
int
-Tk_LabelCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_LabelObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- return ButtonCreate(clientData, interp, argc, argv, TYPE_LABEL);
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_LABEL);
}
int
-Tk_RadiobuttonCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_RadiobuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- return ButtonCreate(clientData, interp, argc, argv, TYPE_RADIO_BUTTON);
+ return ButtonCreate(clientData, interp, objc, objv, TYPE_RADIO_BUTTON);
}
/*
@@ -311,23 +569,42 @@ Tk_RadiobuttonCmd(clientData, interp, argc, argv)
*/
static int
-ButtonCreate(clientData, interp, argc, argv, type)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+ButtonCreate(clientData, interp, objc, objv, type)
+ ClientData clientData; /* Option table for this widget class, or
+ * NULL if not created yet. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ 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. */
{
- register TkButton *butPtr;
- Tk_Window tkwin = (Tk_Window) clientData;
- Tk_Window new;
+ TkButton *butPtr;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ optionTable = (Tk_OptionTable) clientData;
+ if (optionTable == NULL) {
+ Tcl_CmdInfo info;
+ char *name;
+
+ /*
+ * We haven't created the option table for this widget class
+ * yet. Do it now and save the table as the clientData for
+ * the command, so we'll have access to it in future
+ * invocations of the command.
+ */
+
+ TkpButtonSetDefaults(optionSpecs[type]);
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs[type]);
+ name = Tcl_GetString(objv[0]);
+ Tcl_GetCommandInfo(interp, name, &info);
+ info.objClientData = (ClientData) optionTable;
+ Tcl_SetCommandInfo(interp, name, &info);
+ }
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
@@ -335,39 +612,43 @@ ButtonCreate(clientData, interp, argc, argv, type)
* Create the new window.
*/
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
- if (new == NULL) {
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
return TCL_ERROR;
}
- Tk_SetClass(new, classNames[type]);
- butPtr = TkpCreateButton(new);
+ Tk_SetClass(tkwin, classNames[type]);
+ butPtr = TkpCreateButton(tkwin);
- TkSetClassProcs(new, &tkpButtonProcs, (ClientData) butPtr);
+ TkSetClassProcs(tkwin, &tkpButtonProcs, (ClientData) butPtr);
/*
* Initialize the data structure for the button.
*/
- butPtr->tkwin = new;
- butPtr->display = Tk_Display(new);
- butPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(butPtr->tkwin),
- ButtonWidgetCmd, (ClientData) butPtr, ButtonCmdDeletedProc);
+ butPtr->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->text = NULL;
+ butPtr->optionTable = optionTable;
+ butPtr->textPtr = NULL;
butPtr->underline = -1;
- butPtr->textVarName = NULL;
+ butPtr->textVarNamePtr = NULL;
butPtr->bitmap = None;
- butPtr->imageString = NULL;
+ butPtr->imagePtr = NULL;
butPtr->image = NULL;
- butPtr->selectImageString = NULL;
+ butPtr->selectImagePtr = NULL;
butPtr->selectImage = NULL;
- butPtr->state = tkNormalUid;
+ 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;
@@ -378,43 +659,53 @@ ButtonCreate(clientData, interp, argc, argv, type)
butPtr->disabledFg = NULL;
butPtr->normalTextGC = None;
butPtr->activeTextGC = None;
- butPtr->gray = None;
butPtr->disabledGC = None;
+ butPtr->gray = None;
butPtr->copyGC = None;
- butPtr->widthString = NULL;
- butPtr->heightString = NULL;
+ 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->textLayout = NULL;
butPtr->indicatorOn = 0;
butPtr->selectBorder = NULL;
+ butPtr->textWidth = 0;
+ butPtr->textHeight = 0;
+ butPtr->textLayout = NULL;
butPtr->indicatorSpace = 0;
butPtr->indicatorDiameter = 0;
- butPtr->defaultState = tkDisabledUid;
- butPtr->selVarName = NULL;
- butPtr->onValue = NULL;
- butPtr->offValue = NULL;
+ butPtr->defaultState = DEFAULT_DISABLED;
+ butPtr->selVarNamePtr = NULL;
+ butPtr->onValuePtr = NULL;
+ butPtr->offValuePtr = NULL;
butPtr->cursor = None;
- butPtr->command = NULL;
- butPtr->takeFocus = NULL;
+ butPtr->takeFocusPtr = NULL;
+ butPtr->commandPtr = NULL;
butPtr->flags = 0;
Tk_CreateEventHandler(butPtr->tkwin,
ExposureMask|StructureNotifyMask|FocusChangeMask,
ButtonEventProc, (ClientData) butPtr);
- if (ConfigureButton(interp, butPtr, argc - 2, argv + 2,
- configFlags[type]) != TCL_OK) {
+ 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;
}
- interp->result = Tk_PathName(butPtr->tkwin);
+ Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_PathName(butPtr->tkwin),
+ -1);
return TCL_OK;
}
@@ -437,147 +728,155 @@ ButtonCreate(clientData, interp, argc, argv, type)
*/
static int
-ButtonWidgetCmd(clientData, interp, argc, argv)
+ButtonWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about button widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- register TkButton *butPtr = (TkButton *) clientData;
- int result = TCL_OK;
- size_t length;
- int c;
-
- if (argc < 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s option ?arg arg ...?\"",
- argv[0]);
+ 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);
- c = argv[1][0];
- length = strlen(argv[1]);
-
- if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
- }
- result = Tk_ConfigureValue(interp, butPtr->tkwin, tkpButtonConfigSpecs,
- (char *) butPtr, argv[2], configFlags[butPtr->type]);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, butPtr->tkwin,
- tkpButtonConfigSpecs, (char *) butPtr, (char *) NULL,
- configFlags[butPtr->type]);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, butPtr->tkwin,
- tkpButtonConfigSpecs, (char *) butPtr, argv[2],
- configFlags[butPtr->type]);
- } else {
- result = ConfigureButton(interp, butPtr, argc-2, argv+2,
- configFlags[butPtr->type] | TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 'd') && (strncmp(argv[1], "deselect", length) == 0)
- && (butPtr->type >= TYPE_CHECK_BUTTON)) {
- if (argc > 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s deselect\"",
- argv[0]);
- goto error;
- }
- if (butPtr->type == TYPE_CHECK_BUTTON) {
- if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
+
+ switch (map[butPtr->type][index]) {
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ goto error;
}
- } else if (butPtr->flags & SELECTED) {
- if (Tcl_SetVar(interp, butPtr->selVarName, "",
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- };
- }
- } else if ((c == 'f') && (strncmp(argv[1], "flash", length) == 0)
- && (butPtr->type != TYPE_LABEL)) {
- int i;
-
- if (argc > 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s flash\"",
- argv[0]);
- goto error;
- }
- if (butPtr->state != tkDisabledUid) {
- for (i = 0; i < 4; i++) {
- butPtr->state = (butPtr->state == tkNormalUid)
- ? tkActiveUid : tkNormalUid;
- Tk_SetBackgroundFromBorder(butPtr->tkwin,
- (butPtr->state == tkActiveUid) ? butPtr->activeBorder
- : butPtr->normalBorder);
- TkpDisplayButton((ClientData) butPtr);
-
- /*
- * Special note: must cancel any existing idle handler
- * for TkpDisplayButton; it's no longer needed, and TkpDisplayButton
- * cleared the REDRAW_PENDING flag.
- */
-
- Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
- XFlush(butPtr->display);
- Tcl_Sleep(50);
+ objPtr = Tk_GetOptionValue(interp, (char *) butPtr,
+ butPtr->optionTable, objv[2], butPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
}
+ break;
}
- } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
- && (butPtr->type > TYPE_LABEL)) {
- if (argc > 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s invoke\"",
- argv[0]);
- goto error;
+
+ 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;
}
- if (butPtr->state != tkDisabledUid) {
- result = TkInvokeButton(butPtr);
+
+ 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;
}
- } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)
- && (butPtr->type >= TYPE_CHECK_BUTTON)) {
- if (argc > 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s select\"",
- argv[0]);
- goto error;
+
+ 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;
}
- if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
+
+ case COMMAND_INVOKE: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "invoke");
+ goto error;
+ }
+ if (butPtr->state != STATE_DISABLED) {
+ result = TkInvokeButton(butPtr);
+ }
+ break;
}
- } else if ((c == 't') && (strncmp(argv[1], "toggle", length) == 0)
- && (length >= 2) && (butPtr->type == TYPE_CHECK_BUTTON)) {
- if (argc > 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s toggle\"",
- argv[0]);
- goto error;
+
+ 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;
}
- if (butPtr->flags & SELECTED) {
- if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->offValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
+
+ case COMMAND_TOGGLE: {
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "toggle");
+ goto error;
}
- } else {
- if (Tcl_SetVar(interp, butPtr->selVarName, butPtr->onValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_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;
}
- } else {
- sprintf(interp->result,
- "bad option \"%.50s\": must be %s", argv[1],
- optionStrings[butPtr->type]);
- goto error;
}
Tcl_Release((ClientData) butPtr);
return result;
@@ -592,15 +891,14 @@ ButtonWidgetCmd(clientData, interp, argc, argv)
*
* DestroyButton --
*
- * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
- * to clean up the internal structure of a button at a safe time
- * (when no-one is using it anymore).
+ * 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 up.
+ * Everything associated with the widget is freed.
*
*----------------------------------------------------------------------
*/
@@ -609,14 +907,22 @@ static void
DestroyButton(butPtr)
TkButton *butPtr; /* Info about button widget. */
{
+ TkpDestroyButton(butPtr);
+
+ butPtr->flags |= BUTTON_DELETED;
+ if (butPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
+ }
+
/*
* Free up all the stuff that requires special handling, then
* let Tk_FreeOptions handle all the standard option-related
* stuff.
*/
- if (butPtr->textVarName != NULL) {
- Tcl_UntraceVar(butPtr->interp, butPtr->textVarName,
+ 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);
}
@@ -632,24 +938,27 @@ DestroyButton(butPtr)
if (butPtr->activeTextGC != None) {
Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
}
- if (butPtr->gray != None) {
- Tk_FreeBitmap(butPtr->display, butPtr->gray);
- }
if (butPtr->disabledGC != None) {
Tk_FreeGC(butPtr->display, butPtr->disabledGC);
}
+ if (butPtr->gray != None) {
+ Tk_FreeBitmap(butPtr->display, butPtr->gray);
+ }
if (butPtr->copyGC != None) {
Tk_FreeGC(butPtr->display, butPtr->copyGC);
}
- if (butPtr->selVarName != NULL) {
- Tcl_UntraceVar(butPtr->interp, butPtr->selVarName,
+ 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_FreeTextLayout(butPtr->textLayout);
- Tk_FreeOptions(tkpButtonConfigSpecs, (char *) butPtr, butPtr->display,
- configFlags[butPtr->type]);
- Tcl_EventuallyFree((ClientData)butPtr, TCL_DYNAMIC);
+ Tk_FreeConfigOptions((char *) butPtr, butPtr->optionTable,
+ butPtr->tkwin);
+ butPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) butPtr, TCL_DYNAMIC);
}
/*
@@ -657,13 +966,12 @@ DestroyButton(butPtr)
*
* ConfigureButton --
*
- * This procedure is called to process an argv/argc list, plus
- * the Tk option database, in order to configure (or
- * reconfigure) a button widget.
+ * 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 interp->result contains an error message.
+ * returned, then an error message is left in interp's result.
*
* Side effects:
* Configuration information, such as text string, colors, font,
@@ -674,199 +982,244 @@ DestroyButton(butPtr)
*/
static int
-ConfigureButton(interp, butPtr, argc, argv, flags)
+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 argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to Tk_ConfigureWidget. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
Tk_Image image;
/*
* Eliminate any existing trace on variables monitored by the button.
*/
- if (butPtr->textVarName != NULL) {
- Tcl_UntraceVar(interp, butPtr->textVarName,
+ 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->selVarName != NULL) {
- Tcl_UntraceVar(interp, butPtr->selVarName,
+ if (butPtr->selVarNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(butPtr->selVarNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ButtonVarProc, (ClientData) butPtr);
}
-
-
- if (Tk_ConfigureWidget(interp, butPtr->tkwin, tkpButtonConfigSpecs,
- argc, argv, (char *) butPtr, flags) != TCL_OK) {
- return TCL_ERROR;
- }
-
/*
- * A few options need special processing, such as setting the
- * background from a 3-D border, or filling in complicated
- * defaults that couldn't be specified to Tk_ConfigureWidget.
+ * 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.
*/
- if ((butPtr->state == tkActiveUid) && !Tk_StrictMotif(butPtr->tkwin)) {
- Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->activeBorder);
- } else {
- Tk_SetBackgroundFromBorder(butPtr->tkwin, butPtr->normalBorder);
- if ((butPtr->state != tkNormalUid) && (butPtr->state != tkActiveUid)
- && (butPtr->state != tkDisabledUid)) {
- Tcl_AppendResult(interp, "bad state value \"", butPtr->state,
- "\": must be normal, active, or disabled", (char *) NULL);
- butPtr->state = tkNormalUid;
- return TCL_ERROR;
- }
- }
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
- if ((butPtr->defaultState != tkActiveUid)
- && (butPtr->defaultState != tkDisabledUid)
- && (butPtr->defaultState != tkNormalUid)) {
- Tcl_AppendResult(interp, "bad -default value \"", butPtr->defaultState,
- "\": must be normal, active, or disabled", (char *) NULL);
- butPtr->defaultState = tkDisabledUid;
- return TCL_ERROR;
- }
+ if (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.
+ */
- if (butPtr->highlightWidth < 0) {
- butPtr->highlightWidth = 0;
- }
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
- if (butPtr->padX < 0) {
- butPtr->padX = 0;
- }
- if (butPtr->padY < 0) {
- butPtr->padY = 0;
- }
+ /*
+ * 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->type >= TYPE_CHECK_BUTTON) {
- char *value;
+ 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->selVarName == NULL) {
- butPtr->selVarName = (char *) ckalloc((unsigned)
- (strlen(Tk_Name(butPtr->tkwin)) + 1));
- strcpy(butPtr->selVarName, Tk_Name(butPtr->tkwin));
+ 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;
+ }
+ }
}
/*
- * 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.
+ * 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.
*/
-
- value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY);
- butPtr->flags &= ~SELECTED;
- if (value != NULL) {
- if (strcmp(value, butPtr->onValue) == 0) {
- butPtr->flags |= SELECTED;
+
+ if (butPtr->imagePtr != NULL) {
+ image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
+ Tcl_GetString(butPtr->imagePtr), ButtonImageProc,
+ (ClientData) butPtr);
+ if (image == NULL) {
+ continue;
}
} else {
- if (Tcl_SetVar(interp, butPtr->selVarName,
- (butPtr->type == TYPE_CHECK_BUTTON) ? butPtr->offValue : "",
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+ 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;
}
- Tcl_TraceVar(interp, butPtr->selVarName,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- ButtonVarProc, (ClientData) butPtr);
- }
-
- /*
- * Get the images for the widget, if there are any. Allocate the
- * new images before freeing the old ones, so that the reference
- * counts don't go to zero and cause image data to be discarded.
- */
-
- if (butPtr->imageString != NULL) {
- image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
- butPtr->imageString, ButtonImageProc, (ClientData) butPtr);
- if (image == NULL) {
- return TCL_ERROR;
+ if (butPtr->selectImage != NULL) {
+ Tk_FreeImage(butPtr->selectImage);
}
- } else {
- image = NULL;
- }
- if (butPtr->image != NULL) {
- Tk_FreeImage(butPtr->image);
- }
- butPtr->image = image;
- if (butPtr->selectImageString != NULL) {
- image = Tk_GetImage(butPtr->interp, butPtr->tkwin,
- butPtr->selectImageString, ButtonSelectImageProc,
- (ClientData) butPtr);
- if (image == NULL) {
- return TCL_ERROR;
+ butPtr->selectImage = image;
+
+ if ((butPtr->imagePtr == NULL) && (butPtr->bitmap == None)
+ && (butPtr->textVarNamePtr != NULL)) {
+ /*
+ * The button must display the value of a variable: set up a trace
+ * on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ Tcl_Obj *valuePtr, *namePtr;
+
+ namePtr = butPtr->textVarNamePtr;
+ valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ if (Tcl_ObjSetVar2(interp, namePtr, NULL, butPtr->textPtr,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
+ continue;
+ }
+ } else {
+ if (butPtr->textPtr != NULL) {
+ Tcl_DecrRefCount(butPtr->textPtr);
+ }
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
+ }
}
- } else {
- image = NULL;
- }
- if (butPtr->selectImage != NULL) {
- Tk_FreeImage(butPtr->selectImage);
- }
- butPtr->selectImage = image;
-
- if ((butPtr->image == NULL) && (butPtr->bitmap == None)
- && (butPtr->textVarName != NULL)) {
- /*
- * The button must display the value of a variable: set up a trace
- * on the variable's value, create the variable if it doesn't
- * exist, and fetch its current value.
- */
-
- char *value;
-
- value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY);
- if (value == NULL) {
- if (Tcl_SetVar(interp, butPtr->textVarName, butPtr->text,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- return TCL_ERROR;
+
+ 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 {
- if (butPtr->text != NULL) {
- ckfree(butPtr->text);
+ /*
+ * 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;
}
- butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
- strcpy(butPtr->text, value);
}
- Tcl_TraceVar(interp, butPtr->textVarName,
+ 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->bitmap != None) || (butPtr->image != NULL)) {
- if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->widthString,
- &butPtr->width) != TCL_OK) {
- widthError:
- Tcl_AddErrorInfo(interp, "\n (processing -width option)");
- return TCL_ERROR;
- }
- if (Tk_GetPixels(interp, butPtr->tkwin, butPtr->heightString,
- &butPtr->height) != TCL_OK) {
- heightError:
- Tcl_AddErrorInfo(interp, "\n (processing -height option)");
- return TCL_ERROR;
- }
- } else {
- if (Tcl_GetInt(interp, butPtr->widthString, &butPtr->width)
- != TCL_OK) {
- goto widthError;
- }
- if (Tcl_GetInt(interp, butPtr->heightString, &butPtr->height)
- != TCL_OK) {
- goto heightError;
- }
+ 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);
- return TCL_OK;
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
}
/*
@@ -914,60 +1267,48 @@ TkButtonWorldChanged(instanceData)
gcValues.graphics_exposures = False;
mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
- newGC = Tk_GetGCColor(butPtr->tkwin, mask, &gcValues,
- butPtr->normalFg,
- Tk_3DBorderColor(butPtr->normalBorder));
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
if (butPtr->normalTextGC != None) {
Tk_FreeGC(butPtr->display, butPtr->normalTextGC);
}
butPtr->normalTextGC = newGC;
if (butPtr->activeFg != NULL) {
- gcValues.font = Tk_FontId(butPtr->tkfont);
gcValues.foreground = butPtr->activeFg->pixel;
gcValues.background = Tk_3DBorderColor(butPtr->activeBorder)->pixel;
mask = GCForeground | GCBackground | GCFont;
- newGC = Tk_GetGCColor(butPtr->tkwin, mask, &gcValues,
- butPtr->activeFg,
- Tk_3DBorderColor(butPtr->activeBorder));
+ newGC = Tk_GetGC(butPtr->tkwin, mask, &gcValues);
if (butPtr->activeTextGC != None) {
Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
}
butPtr->activeTextGC = newGC;
}
- if (butPtr->type != TYPE_LABEL) {
- XColor *foreground, *background;
-
- gcValues.font = Tk_FontId(butPtr->tkfont);
- background = Tk_3DBorderColor(butPtr->normalBorder);
- gcValues.background = background->pixel;
- if ((butPtr->disabledFg != NULL) && (butPtr->imageString == NULL)) {
- foreground = butPtr->disabledFg;
- gcValues.foreground = foreground->pixel;
- mask = GCForeground | GCBackground | GCFont;
- } else {
- foreground = background;
- background = NULL;
- gcValues.foreground = gcValues.background;
- mask = GCForeground;
- if (butPtr->gray == None) {
- butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin,
- Tk_GetUid("gray50"));
- }
- if (butPtr->gray != None) {
- gcValues.fill_style = FillStippled;
- gcValues.stipple = butPtr->gray;
- mask |= GCFillStyle | GCStipple;
- }
+ /*
+ * 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->gray == None) {
+ butPtr->gray = Tk_GetBitmap(NULL, butPtr->tkwin, "gray50");
}
- newGC = Tk_GetGCColor(butPtr->tkwin, mask, &gcValues, foreground,
- background);
- if (butPtr->disabledGC != None) {
- Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ if (butPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = butPtr->gray;
+ mask |= GCFillStyle | GCStipple;
}
- butPtr->disabledGC = newGC;
}
+ 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);
@@ -1019,14 +1360,6 @@ ButtonEventProc(clientData, eventPtr)
goto redraw;
} else if (eventPtr->type == DestroyNotify) {
- TkpDestroyButton(butPtr);
- if (butPtr->tkwin != NULL) {
- butPtr->tkwin = NULL;
- Tcl_DeleteCommandFromToken(butPtr->interp, butPtr->widgetCmd);
- }
- if (butPtr->flags & REDRAW_PENDING) {
- Tcl_CancelIdleCall(TkpDisplayButton, (ClientData) butPtr);
- }
DestroyButton(butPtr);
} else if (eventPtr->type == FocusIn) {
if (eventPtr->xfocus.detail != NotifyInferior) {
@@ -1075,18 +1408,16 @@ ButtonCmdDeletedProc(clientData)
ClientData clientData; /* Pointer to widget record for widget. */
{
TkButton *butPtr = (TkButton *) clientData;
- Tk_Window tkwin = butPtr->tkwin;
/*
* This procedure could be invoked either because the window was
- * destroyed and the command was then deleted (in which case tkwin
- * is NULL) or because the command was deleted, and then this procedure
- * destroys the widget.
+ * 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 (tkwin != NULL) {
- butPtr->tkwin = NULL;
- Tk_DestroyWindow(tkwin);
+ if (!(butPtr->flags & BUTTON_DELETED)) {
+ Tk_DestroyWindow(butPtr->tkwin);
}
}
@@ -1102,7 +1433,7 @@ ButtonCmdDeletedProc(clientData)
*
* Results:
* A standard Tcl return value. Information is also left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* Depends on the button and its associated command.
@@ -1112,28 +1443,34 @@ ButtonCmdDeletedProc(clientData)
int
TkInvokeButton(butPtr)
- register TkButton *butPtr; /* Information about button. */
+ TkButton *butPtr; /* Information about button. */
{
+ Tcl_Obj *namePtr = butPtr->selVarNamePtr;
+
if (butPtr->type == TYPE_CHECK_BUTTON) {
if (butPtr->flags & SELECTED) {
- if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->offValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ if (Tcl_ObjSetVar2(butPtr->interp, namePtr, NULL,
+ butPtr->offValuePtr, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
+ == NULL) {
return TCL_ERROR;
}
} else {
- if (Tcl_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ 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_SetVar(butPtr->interp, butPtr->selVarName, butPtr->onValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ 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->command != NULL)) {
- return TkCopyAndGlobalEval(butPtr->interp, butPtr->command);
+ if ((butPtr->type != TYPE_LABEL) && (butPtr->commandPtr != NULL)) {
+ return Tcl_EvalObjEx(butPtr->interp, butPtr->commandPtr,
+ TCL_EVAL_GLOBAL);
}
return TCL_OK;
}
@@ -1167,7 +1504,10 @@ ButtonVarProc(clientData, interp, name1, name2, flags)
int flags; /* Information about what happened. */
{
register TkButton *butPtr = (TkButton *) clientData;
- char *value;
+ char *name, *value;
+ Tcl_Obj *valuePtr;
+
+ name = Tcl_GetString(butPtr->selVarNamePtr);
/*
* If the variable is being unset, then just re-establish the
@@ -1177,7 +1517,7 @@ ButtonVarProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
butPtr->flags &= ~SELECTED;
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
- Tcl_TraceVar(interp, butPtr->selVarName,
+ Tcl_TraceVar(interp, name,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ButtonVarProc, clientData);
}
@@ -1189,11 +1529,13 @@ ButtonVarProc(clientData, interp, name1, name2, flags)
* the button.
*/
- value = Tcl_GetVar(interp, butPtr->selVarName, TCL_GLOBAL_ONLY);
- if (value == NULL) {
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
value = "";
+ } else {
+ value = Tcl_GetString(valuePtr);
}
- if (strcmp(value, butPtr->onValue) == 0) {
+ if (strcmp(value, Tcl_GetString(butPtr->onValuePtr)) == 0) {
if (butPtr->flags & SELECTED) {
return (char *) NULL;
}
@@ -1240,8 +1582,11 @@ ButtonTextVarProc(clientData, interp, name1, name2, flags)
char *name2; /* Not used. */
int flags; /* Information about what happened. */
{
- register TkButton *butPtr = (TkButton *) clientData;
- char *value;
+ TkButton *butPtr = (TkButton *) clientData;
+ char *name;
+ Tcl_Obj *valuePtr;
+
+ name = Tcl_GetString(butPtr->textVarNamePtr);
/*
* If the variable is unset, then immediately recreate it unless
@@ -1250,24 +1595,22 @@ ButtonTextVarProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
- Tcl_SetVar(interp, butPtr->textVarName, butPtr->text,
+ Tcl_SetVar2Ex(interp, name, NULL, butPtr->textPtr,
TCL_GLOBAL_ONLY);
- Tcl_TraceVar(interp, butPtr->textVarName,
+ Tcl_TraceVar(interp, name,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ButtonTextVarProc, clientData);
}
return (char *) NULL;
}
- value = Tcl_GetVar(interp, butPtr->textVarName, TCL_GLOBAL_ONLY);
- if (value == NULL) {
- value = "";
- }
- if (butPtr->text != NULL) {
- ckfree(butPtr->text);
+ valuePtr = Tcl_GetVar2Ex(interp, name, NULL, TCL_GLOBAL_ONLY);
+ if (valuePtr == NULL) {
+ valuePtr = Tcl_NewObj();
}
- butPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
- strcpy(butPtr->text, value);
+ Tcl_DecrRefCount(butPtr->textPtr);
+ butPtr->textPtr = valuePtr;
+ Tcl_IncrRefCount(butPtr->textPtr);
TkpComputeButtonGeometry(butPtr);
if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
@@ -1284,7 +1627,7 @@ ButtonTextVarProc(clientData, interp, name1, name2, flags)
* ButtonImageProc --
*
* This procedure is invoked by the image code whenever the manager
- * for an image does something that affects the size of contents
+ * for an image does something that affects the size or contents
* of an image displayed in a button.
*
* Results:
@@ -1322,7 +1665,7 @@ ButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
* ButtonSelectImageProc --
*
* This procedure is invoked by the image code whenever the manager
- * for an image does something that affects the size of contents
+ * for an image does something that affects the size or contents
* of the image displayed in a button when it is selected.
*
* Results:
diff --git a/tk/generic/tkButton.h b/tk/generic/tkButton.h
index 6236fc74c30..d0e28822c16 100644
--- a/tk/generic/tkButton.h
+++ b/tk/generic/tkButton.h
@@ -4,7 +4,7 @@
* Declarations of types and functions used to implement
* button-like widgets.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * 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.
@@ -25,6 +25,22 @@
#endif
/*
+ * Legal values for the "state" field of TkButton records.
+ */
+
+enum state {
+ STATE_ACTIVE, STATE_DISABLED, STATE_NORMAL
+};
+
+/*
+ * Legal values for the "defaultState" field of TkButton records.
+ */
+
+enum defaultState {
+ DEFAULT_ACTIVE, DEFAULT_DISABLED, DEFAULT_NORMAL
+};
+
+/*
* A data structure of the following type is kept for each
* widget managed by this file:
*/
@@ -36,69 +52,88 @@ typedef struct {
* free up resources after tkwin is gone. */
Tcl_Interp *interp; /* Interpreter associated with button. */
Tcl_Command widgetCmd; /* Token for button's widget command. */
- int type; /* Type of widget: restricts operations
- * that may be performed on widget. See
- * below for possible values. */
+ 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.
*/
- char *text; /* Text to display in button (malloc'ed)
- * or NULL. */
- int underline; /* Index of character to underline. < 0 means
+ 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. */
- char *textVarName; /* Name of variable (malloc'ed) or NULL.
- * If non-NULL, button displays the contents
- * of this variable. */
- Pixmap bitmap; /* Bitmap to display or None. If not None
- * then text and textVar are ignored. */
- char *imageString; /* Name of image to display (malloc'ed), or
- * NULL. If non-NULL, bitmap, text, and
- * textVarName are ignored. */
- Tk_Image image; /* Image to display in window, or NULL if
- * none. */
- char *selectImageString; /* Name of image to display when selected
- * (malloc'ed), or NULL. */
- Tk_Image selectImage; /* Image to display in window when selected,
- * or NULL if none. Ignored if image is
+ 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:
*/
- Tk_Uid state; /* State of button for display purposes:
- * normal, active, or disabled. */
- Tk_3DBorder normalBorder; /* Structure used to draw 3-D
- * border and background when window
- * isn't active. NULL means no such
- * border exists. */
- Tk_3DBorder activeBorder; /* Structure used to draw 3-D
- * border and background when window
- * is active. NULL means no such
- * border exists. */
- int borderWidth; /* Width of border. */
- int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */
- int highlightWidth; /* Width in pixels of highlight to draw
- * around widget when it has the focus.
+ enum state state; /* Value of -state option: specifies
+ * state of button for display purposes.*/
+ Tk_3DBorder normalBorder; /* Value of -background option: specifies
+ * color for background (and border) when
+ * window isn't active. */
+ Tk_3DBorder activeBorder; /* Value of -activebackground option:
+ * this is the color used to draw 3-D border
+ * and background when widget is active. */
+ Tcl_Obj *borderWidthPtr; /* Value of -borderWidth option: specifies
+ * width of border in pixels. */
+ int borderWidth; /* Integer value corresponding to
+ * borderWidthPtr. Always >= 0. */
+ int relief; /* Value of -relief option: specifies 3-d
+ * effect for border, such as
+ * TK_RELIEF_RAISED. */
+ Tcl_Obj *highlightWidthPtr; /* Value of -highlightthickness option:
+ * specifies width in pixels of highlight to
+ * draw around widget when it has the focus.
* <= 0 means don't draw a highlight. */
- Tk_3DBorder highlightBorder;
- /* Structure used to draw 3-D default ring
- * and focus highlight area when highlight
- * is off. */
- XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
-
+ int 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; /* 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
+ 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
@@ -106,36 +141,47 @@ typedef struct {
* screen. */
GC activeTextGC; /* GC for drawing text in active mode (NULL
* means use normalTextGC). */
- Pixmap gray; /* Pixmap for displaying disabled text if
- * disabledFg is NULL. */
GC disabledGC; /* Used to produce disabled effect. If
* disabledFg isn't NULL, this GC is used to
* draw button text or icon. Otherwise
* text or icon is drawn with normalGC and
* this GC is used to stipple background
* across it. For labels this is None. */
+ 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. */
- 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
+ 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 padX, padY; /* Extra space around text (pixels to leave
- * on each side). Ignored for bitmaps and
+ 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. */
- Tk_Anchor anchor; /* Where text/bitmap should be displayed
- * inside button region. */
- Tk_Justify justify; /* Justification to use for multi-line text. */
- int indicatorOn; /* True means draw indicator, false means
- * don't draw it. */
- Tk_3DBorder selectBorder; /* For drawing indicator background, or perhaps
- * widget background, when selected. */
+ int 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,
@@ -144,36 +190,42 @@ typedef struct {
int indicatorSpace; /* Horizontal space (in pixels) allocated for
* display of indicator. */
int indicatorDiameter; /* Diameter of indicator, in pixels. */
- Tk_Uid defaultState; /* State of default ring: normal, active, or
- * disabled. */
-
+ 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.
*/
- char *selVarName; /* Name of variable used to control selected
- * state of button. Malloc'ed (if
- * not NULL). */
- char *onValue; /* Value to store in variable when
- * this button is selected. Malloc'ed (if
- * not NULL). */
- char *offValue; /* Value to store in variable when this
- * button isn't selected. Malloc'ed
- * (if not NULL). Valid only for check
- * buttons. */
+ 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; /* Current cursor for window, or None. */
- char *takeFocus; /* Value of -takefocus option; not used in
+ 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. Malloc'ed, but may be NULL. */
- char *command; /* Command to execute when button is
- * invoked; valid for buttons only.
- * If not NULL, it's malloc-ed. */
+ * scripts. */
+ Tcl_Obj *commandPtr; /* Value of -command option: specifies script
+ * to execute when button is invoked. If
+ * widget is label or has no command, this
+ * is NULL. */
int flags; /* Various flags; see below for
* definitions. */
} TkButton;
@@ -200,36 +252,31 @@ typedef struct {
* so special highlight should be drawn.
* GOT_FOCUS: Non-zero means this button currently
* has the input focus.
+ * BUTTON_DELETED: Non-zero needs that this button has been
+ * deleted, or is in the process of being
+ * deleted.
*/
#define REDRAW_PENDING 1
#define SELECTED 2
#define GOT_FOCUS 4
-
-/*
- * Mask values used to selectively enable entries in the
- * configuration specs:
- */
-
-#define LABEL_MASK TK_CONFIG_USER_BIT
-#define BUTTON_MASK TK_CONFIG_USER_BIT << 1
-#define CHECK_BUTTON_MASK TK_CONFIG_USER_BIT << 2
-#define RADIO_BUTTON_MASK TK_CONFIG_USER_BIT << 3
-#define ALL_MASK (LABEL_MASK | BUTTON_MASK \
- | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK)
+#define BUTTON_DELETED 0x8
/*
* Declaration of variables shared between the files in the button module.
*/
extern TkClassProcs tkpButtonProcs;
-extern Tk_ConfigSpec tkpButtonConfigSpecs[];
/*
* Declaration of procedures used in the implementation of the button
* widget.
*/
+#ifndef TkpButtonSetDefaults
+EXTERN void TkpButtonSetDefaults _ANSI_ARGS_((
+ Tk_OptionSpec *specPtr));
+#endif
EXTERN void TkButtonWorldChanged _ANSI_ARGS_((
ClientData instanceData));
EXTERN void TkpComputeButtonGeometry _ANSI_ARGS_((
@@ -247,3 +294,4 @@ EXTERN int TkInvokeButton _ANSI_ARGS_((TkButton *butPtr));
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKBUTTON */
+
diff --git a/tk/generic/tkCanvArc.c b/tk/generic/tkCanvArc.c
index cec4ef2b5fb..e2c3504fd1e 100644
--- a/tk/generic/tkCanvArc.c
+++ b/tk/generic/tkCanvArc.c
@@ -4,7 +4,7 @@
* This file implements arc items for canvas widgets.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -15,14 +15,19 @@
#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
@@ -38,16 +43,22 @@ typedef struct ArcItem {
* for a chord). Malloc'ed. */
int numOutlinePoints; /* Number of points at outlinePtr. Zero
* means no space allocated. */
- int width; /* Width of outline (in pixels). */
- XColor *outlineColor; /* Color for outline. NULL means don't
- * draw outline. */
+ 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 outlineStipple; /* Stipple bitmap for outline. */
- Tk_Uid style; /* How to draw arc: arc, chord, or pieslice. */
- GC outlineGC; /* Graphics context for outline. */
+ 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). */
@@ -68,29 +79,112 @@ typedef struct ArcItem {
* Information used for parsing configuration specs:
*/
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+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, outlineColor), TK_CONFIG_NULL_OK},
+ "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, outlineStipple), TK_CONFIG_NULL_OK},
+ (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_UID, "-style", (char *) NULL, (char *) NULL,
- "pieslice", Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT},
+ {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_PIXELS, "-width", (char *) NULL, (char *) NULL,
- "1", Tk_Offset(ArcItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {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}
};
@@ -103,10 +197,10 @@ static void ComputeArcBbox _ANSI_ARGS_((Tk_Canvas canvas,
ArcItem *arcPtr));
static int ConfigureArc _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeleteArc _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas,
@@ -114,7 +208,7 @@ static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas,
int x, int y, int width, int height));
static int ArcCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv));
+ Tcl_Obj *CONST argv[]));
static int ArcToArea _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double *rectPtr));
static double ArcToPoint _ANSI_ARGS_((Tk_Canvas canvas,
@@ -128,7 +222,8 @@ static void TranslateArc _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double deltaX, double deltaY));
static int AngleInRange _ANSI_ARGS_((double x, double y,
double start, double extent));
-static void ComputeArcOutline _ANSI_ARGS_((ArcItem *arcPtr));
+static 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));
@@ -150,7 +245,7 @@ Tk_ItemType tkArcType = {
ArcCoords, /* coordProc */
DeleteArc, /* deleteProc */
DisplayArc, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
ArcToPoint, /* pointProc */
ArcToArea, /* areaProc */
ArcToPostscript, /* postscriptProc */
@@ -161,21 +256,13 @@ Tk_ItemType tkArcType = {
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
(Tk_ItemInsertProc *) NULL, /* insertProc */
(Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
#ifndef PI
# define PI 3.14159265358979323846
#endif
-/*
- * The uid's below comprise the legal values for the "-style"
- * option for arcs.
- */
-
-static Tk_Uid arcUid = NULL;
-static Tk_Uid chordUid = NULL;
-static Tk_Uid pieSliceUid = NULL;
/*
*--------------------------------------------------------------
@@ -188,7 +275,7 @@ static Tk_Uid pieSliceUid = NULL;
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is
+ * the interp's result; in this case itemPtr is
* left uninitialized, so it can be safely freed by the
* caller.
*
@@ -205,11 +292,23 @@ CreateArc(interp, canvas, itemPtr, argc, argv)
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing arc. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing arc. */
{
ArcItem *arcPtr = (ArcItem *) itemPtr;
+ int i;
- if (argc < 4) {
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(argv[1], NULL);
+ if ((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ } else {
+ i = 4;
+ }
+ }
+ if (argc < i) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
@@ -218,52 +317,40 @@ CreateArc(interp, canvas, itemPtr, argc, argv)
}
/*
- * Carry out once-only initialization.
- */
-
- if (arcUid == NULL) {
- arcUid = Tk_GetUid("arc");
- chordUid = Tk_GetUid("chord");
- pieSliceUid = Tk_GetUid("pieslice");
- }
-
- /*
* Carry out initialization that is needed in order to clean
* up after errors during the the remainder of this procedure.
*/
+ Tk_CreateOutline(&(arcPtr->outline));
arcPtr->start = 0;
arcPtr->extent = 90;
arcPtr->outlinePtr = NULL;
arcPtr->numOutlinePoints = 0;
- arcPtr->width = 1;
- arcPtr->outlineColor = NULL;
+ 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->outlineStipple = None;
- arcPtr->style = pieSliceUid;
- arcPtr->outlineGC = None;
+ arcPtr->activeFillStipple = None;
+ arcPtr->disabledFillStipple = None;
+ arcPtr->style = PIESLICE_STYLE;
arcPtr->fillGC = None;
/*
* Process the arguments to fill in the item record.
*/
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &arcPtr->bbox[0]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
- &arcPtr->bbox[1]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[2],
- &arcPtr->bbox[2]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[3],
- &arcPtr->bbox[3]) != TCL_OK)) {
- return TCL_ERROR;
+ if ((ArcCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
}
-
- if (ConfigureArc(interp, canvas, itemPtr, argc-4, argv+4, 0) != TCL_OK) {
- DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
- return TCL_ERROR;
+ if (ConfigureArc(interp, canvas, itemPtr, argc-4, argv+4, 0) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
+ error:
+ DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
}
/*
@@ -276,7 +363,7 @@ CreateArc(interp, canvas, itemPtr, argc, argv)
* on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -292,36 +379,51 @@ ArcCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
ArcItem *arcPtr = (ArcItem *) itemPtr;
- char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE];
- char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE];
if (argc == 0) {
- Tcl_PrintDouble(interp, arcPtr->bbox[0], c0);
- Tcl_PrintDouble(interp, arcPtr->bbox[1], c1);
- Tcl_PrintDouble(interp, arcPtr->bbox[2], c2);
- Tcl_PrintDouble(interp, arcPtr->bbox[3], c3);
- Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3,
- (char *) NULL);
- } else if (argc == 4) {
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
- &arcPtr->bbox[0]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ 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 ((argc == 1)||(argc == 4)) {
+ if (argc==1) {
+ if (Tcl_ListObjGetElements(interp, argv[0], &argc,
+ (Tcl_Obj ***) &argv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (argc != 4) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 4, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0],
+ &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1],
&arcPtr->bbox[1]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[2],
&arcPtr->bbox[2]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[3],
&arcPtr->bbox[3]) != TCL_OK)) {
return TCL_ERROR;
}
ComputeArcBbox(canvas, arcPtr);
} else {
- sprintf(interp->result,
- "wrong # coordinates: expected 0 or 4, got %d",
- argc);
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
@@ -337,7 +439,7 @@ ArcCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information, such as colors and stipple
@@ -352,7 +454,7 @@ ConfigureArc(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Arc item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
ArcItem *arcPtr = (ArcItem *) itemPtr;
@@ -361,18 +463,52 @@ ConfigureArc(interp, canvas, itemPtr, argc, argv, flags)
unsigned long mask;
int i;
Tk_Window tkwin;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
- (char *) arcPtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) arcPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
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) {
@@ -381,60 +517,87 @@ ConfigureArc(interp, canvas, itemPtr, argc, argv, flags)
i = (int) (arcPtr->extent/360.0);
arcPtr->extent -= i*360.0;
- if ((arcPtr->style != arcUid) && (arcPtr->style != chordUid)
- && (arcPtr->style != pieSliceUid)) {
- Tcl_AppendResult(interp, "bad -style option \"",
- arcPtr->style, "\": must be arc, chord, or pieslice",
- (char *) NULL);
- arcPtr->style = pieSliceUid;
- return TCL_ERROR;
+ 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->width < 0) {
- arcPtr->width = 1;
+ if (arcPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->outline.gc);
}
- if (arcPtr->outlineColor == NULL) {
- newGC = None;
- } else {
- gcValues.foreground = arcPtr->outlineColor->pixel;
- gcValues.cap_style = CapButt;
- gcValues.line_width = arcPtr->width;
- mask = GCForeground|GCCapStyle|GCLineWidth;
- if (arcPtr->outlineStipple != None) {
- gcValues.stipple = arcPtr->outlineStipple;
- gcValues.fill_style = FillStippled;
- mask |= GCStipple|GCFillStyle;
- }
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, arcPtr->outlineColor,
- NULL);
+ arcPtr->outline.gc = newGC;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
}
- if (arcPtr->outlineGC != None) {
- Tk_FreeGC(Tk_Display(tkwin), arcPtr->outlineGC);
+ if (state==TK_STATE_HIDDEN) {
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
}
- arcPtr->outlineGC = newGC;
- if ((arcPtr->fillColor == NULL) || (arcPtr->style == arcUid)) {
+ 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 = arcPtr->fillColor->pixel;
- if (arcPtr->style == chordUid) {
+ gcValues.foreground = color->pixel;
+ if (arcPtr->style == CHORD_STYLE) {
gcValues.arc_mode = ArcChord;
} else {
gcValues.arc_mode = ArcPieSlice;
}
mask = GCForeground|GCArcMode;
- if (arcPtr->fillStipple != None) {
- gcValues.stipple = arcPtr->fillStipple;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
gcValues.fill_style = FillStippled;
mask |= GCStipple|GCFillStyle;
}
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, arcPtr->fillColor, NULL);
+ 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;
}
@@ -465,23 +628,27 @@ DeleteArc(canvas, itemPtr, display)
{
ArcItem *arcPtr = (ArcItem *) itemPtr;
+ Tk_DeleteOutline(display, &(arcPtr->outline));
if (arcPtr->numOutlinePoints != 0) {
ckfree((char *) arcPtr->outlinePtr);
}
- if (arcPtr->outlineColor != NULL) {
- Tk_FreeColor(arcPtr->outlineColor);
- }
if (arcPtr->fillColor != NULL) {
Tk_FreeColor(arcPtr->fillColor);
}
+ if (arcPtr->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->outlineStipple != None) {
- Tk_FreeBitmap(display, arcPtr->outlineStipple);
+ if (arcPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->activeFillStipple);
}
- if (arcPtr->outlineGC != None) {
- Tk_FreeGC(display, arcPtr->outlineGC);
+ if (arcPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->disabledFillStipple);
}
if (arcPtr->fillGC != None) {
Tk_FreeGC(display, arcPtr->fillGC);
@@ -514,6 +681,30 @@ ComputeArcBbox(canvas, arcPtr)
* 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.
@@ -532,7 +723,7 @@ ComputeArcBbox(canvas, arcPtr)
arcPtr->bbox[0] = tmp;
}
- ComputeArcOutline(arcPtr);
+ ComputeArcOutline(canvas,arcPtr);
/*
* To compute the bounding box, start with the the bbox formed
@@ -546,7 +737,7 @@ ComputeArcBbox(canvas, arcPtr)
TkIncludePoint((Tk_Item *) arcPtr, arcPtr->center2);
center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2;
center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2;
- if (arcPtr->style == pieSliceUid) {
+ if (arcPtr->style == PIESLICE_STYLE) {
TkIncludePoint((Tk_Item *) arcPtr, center);
}
@@ -592,10 +783,10 @@ ComputeArcBbox(canvas, arcPtr)
* being drawn) and add one extra pixel just for safety.
*/
- if (arcPtr->outlineColor == NULL) {
+ if (arcPtr->outline.gc == None) {
tmp = 1;
} else {
- tmp = (arcPtr->width + 1)/2 + 1;
+ tmp = (int) ((width + 1.0)/2.0 + 1);
}
arcPtr->header.x1 -= (int) tmp;
arcPtr->header.y1 -= (int) tmp;
@@ -633,7 +824,41 @@ DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height)
{
ArcItem *arcPtr = (ArcItem *) itemPtr;
short x1, y1, x2, y2;
- int start, extent;
+ 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,
@@ -660,65 +885,86 @@ DisplayArc(canvas, itemPtr, display, drawable, x, y, width, height)
*/
if ((arcPtr->fillGC != None) && (extent != 0)) {
- if (arcPtr->fillStipple != None) {
- Tk_CanvasSetStippleOrigin(canvas, arcPtr->fillGC);
+ 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 (arcPtr->fillStipple != None) {
+ if (stipple != None) {
XSetTSOrigin(display, arcPtr->fillGC, 0, 0);
}
}
- if (arcPtr->outlineGC != None) {
- if (arcPtr->outlineStipple != None) {
- Tk_CanvasSetStippleOrigin(canvas, arcPtr->outlineGC);
- }
+ if (arcPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(arcPtr->outline));
+
if (extent != 0) {
- XDrawArc(display, drawable, arcPtr->outlineGC, x1, y1,
+ 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.
+ * being displayed); just draw lines instead. The same is done if
+ * the outline is dashed, because then polygons don't work.
*/
- if (arcPtr->width <= 2) {
+ 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 == chordUid) {
- XDrawLine(display, drawable, arcPtr->outlineGC,
+ if (arcPtr->style == CHORD_STYLE) {
+ XDrawLine(display, drawable, arcPtr->outline.gc,
x1, y1, x2, y2);
- } else if (arcPtr->style == pieSliceUid) {
+ } 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->outlineGC,
+ XDrawLine(display, drawable, arcPtr->outline.gc,
cx, cy, x1, y1);
- XDrawLine(display, drawable, arcPtr->outlineGC,
+ XDrawLine(display, drawable, arcPtr->outline.gc,
cx, cy, x2, y2);
}
} else {
- if (arcPtr->style == chordUid) {
+ if (arcPtr->style == CHORD_STYLE) {
TkFillPolygon(canvas, arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
- display, drawable, arcPtr->outlineGC, None);
- } else if (arcPtr->style == pieSliceUid) {
+ display, drawable, arcPtr->outline.gc, None);
+ } else if (arcPtr->style == PIESLICE_STYLE) {
TkFillPolygon(canvas, arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
- display, drawable, arcPtr->outlineGC, None);
+ display, drawable, arcPtr->outline.gc, None);
TkFillPolygon(canvas, arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
- PIE_OUTLINE2_PTS, display, drawable, arcPtr->outlineGC,
+ PIE_OUTLINE2_PTS, display, drawable, arcPtr->outline.gc,
None);
}
}
- if (arcPtr->outlineStipple != None) {
- XSetTSOrigin(display, arcPtr->outlineGC, 0, 0);
- }
+
+ Tk_ResetOutlineGC(canvas, itemPtr, &(arcPtr->outline));
}
}
@@ -756,6 +1002,22 @@ ArcToPoint(canvas, itemPtr, pointPtr)
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.
@@ -766,8 +1028,14 @@ ArcToPoint(canvas, itemPtr, pointPtr)
vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
- t1 = (pointPtr[1] - vertex[1])/(arcPtr->bbox[3] - arcPtr->bbox[1]);
- t2 = (pointPtr[0] - vertex[0])/(arcPtr->bbox[2] - arcPtr->bbox[0]);
+ 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 {
@@ -786,9 +1054,9 @@ ArcToPoint(canvas, itemPtr, pointPtr)
* we're dealing with.
*/
- if (arcPtr->style == arcUid) {
+ if (arcPtr->style == ARC_STYLE) {
if (angleInRange) {
- return TkOvalToPoint(arcPtr->bbox, (double) arcPtr->width,
+ return TkOvalToPoint(arcPtr->bbox, width,
0, pointPtr);
}
dist = hypot(pointPtr[0] - arcPtr->center1[0],
@@ -801,18 +1069,16 @@ ArcToPoint(canvas, itemPtr, pointPtr)
return dist;
}
- if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) {
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
filled = 1;
} else {
filled = 0;
}
- if (arcPtr->outlineGC == None) {
+ if (arcPtr->outline.gc == None) {
width = 0.0;
- } else {
- width = arcPtr->width;
}
- if (arcPtr->style == pieSliceUid) {
+ if (arcPtr->style == PIESLICE_STYLE) {
if (width > 1.0) {
dist = TkPolygonToPoint(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
pointPtr);
@@ -917,16 +1183,29 @@ ArcToArea(canvas, itemPtr, rectPtr)
* 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->outlineGC == None)) {
+ if ((arcPtr->fillGC != None) || (arcPtr->outline.gc == None)) {
filled = 1;
} else {
filled = 0;
}
- if (arcPtr->outlineGC == None) {
+ if (arcPtr->outline.gc == None) {
width = 0.0;
- } else {
- width = arcPtr->width;
}
/*
@@ -967,7 +1246,7 @@ ArcToArea(canvas, itemPtr, rectPtr)
numPoints = 2;
pointPtr += 4;
- if ((arcPtr->style == pieSliceUid) && (arcPtr->extent < 180.0)) {
+ if ((arcPtr->style == PIESLICE_STYLE) && (arcPtr->extent < 180.0)) {
pointPtr[0] = 0.0;
pointPtr[1] = 0.0;
numPoints++;
@@ -1041,7 +1320,7 @@ ArcToArea(canvas, itemPtr, rectPtr)
* polygon(s) forming the sides of a chord or pie-slice.
*/
- if (arcPtr->style == pieSliceUid) {
+ if (arcPtr->style == PIESLICE_STYLE) {
if (width >= 1.0) {
if (TkPolygonToArea(arcPtr->outlinePtr, PIE_OUTLINE1_PTS,
rectPtr) != -1) {
@@ -1057,7 +1336,7 @@ ArcToArea(canvas, itemPtr, rectPtr)
return 0;
}
}
- } else if (arcPtr->style == chordUid) {
+ } else if (arcPtr->style == CHORD_STYLE) {
if (width >= 1.0) {
if (TkPolygonToArea(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
rectPtr) != -1) {
@@ -1209,13 +1488,16 @@ TranslateArc(canvas, itemPtr, deltaX, deltaY)
*/
static void
-ComputeArcOutline(arcPtr)
+ComputeArcOutline(canvas,arcPtr)
+ Tk_Canvas canvas; /* Information about overall canvas. */
ArcItem *arcPtr; /* Information about arc. */
{
- double sin1, cos1, sin2, cos2, angle, halfWidth;
+ 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
@@ -1229,6 +1511,10 @@ ComputeArcOutline(arcPtr)
}
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
@@ -1285,7 +1571,18 @@ ComputeArcOutline(arcPtr)
* the oval.
*/
- halfWidth = arcPtr->width/2.0;
+ 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 {
@@ -1308,11 +1605,11 @@ ComputeArcOutline(arcPtr)
* center point. The second point is the corner point.
*/
- if (arcPtr->style == chordUid) {
+ if (arcPtr->style == CHORD_STYLE) {
outlinePtr[0] = outlinePtr[12] = corner1[0];
outlinePtr[1] = outlinePtr[13] = corner1[1];
TkGetButtPoints(arcPtr->center2, arcPtr->center1,
- (double) arcPtr->width, 0, outlinePtr+10, outlinePtr+2);
+ width, 0, outlinePtr+10, outlinePtr+2);
outlinePtr[4] = arcPtr->center2[0] + outlinePtr[2]
- arcPtr->center1[0];
outlinePtr[5] = arcPtr->center2[1] + outlinePtr[3]
@@ -1323,7 +1620,7 @@ ComputeArcOutline(arcPtr)
- arcPtr->center1[0];
outlinePtr[9] = arcPtr->center2[1] + outlinePtr[11]
- arcPtr->center1[1];
- } else if (arcPtr->style == pieSliceUid) {
+ } 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,
@@ -1339,7 +1636,7 @@ ComputeArcOutline(arcPtr)
*
*/
- TkGetButtPoints(arcPtr->center1, vertex, (double) arcPtr->width, 0,
+ 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];
@@ -1368,7 +1665,7 @@ ComputeArcOutline(arcPtr)
* first two points of the first arm, depending on extent.
*/
- TkGetButtPoints(arcPtr->center2, vertex, (double) arcPtr->width, 0,
+ TkGetButtPoints(arcPtr->center2, vertex, width, 0,
outlinePtr+12, outlinePtr+16);
if ((arcPtr->extent > 180) ||
((arcPtr->extent < 0) && (arcPtr->extent > -180))) {
@@ -1575,7 +1872,7 @@ AngleInRange(x, y, start, extent)
* 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
+ * 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.
*
@@ -1599,6 +1896,11 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
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]);
@@ -1609,6 +1911,41 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
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.
@@ -1619,7 +1956,7 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
(arcPtr->bbox[0] + arcPtr->bbox[2])/2, (y1 + y2)/2,
(arcPtr->bbox[2] - arcPtr->bbox[0])/2, (y1 - y2)/2);
Tcl_AppendResult(interp, buffer, (char *) NULL);
- if (arcPtr->style == chordUid) {
+ if (arcPtr->style == CHORD_STYLE) {
sprintf(buffer, "0 0 1 %.15g %.15g arc closepath\nsetmatrix\n",
ang1, ang2);
} else {
@@ -1628,16 +1965,16 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
ang1, ang2);
}
Tcl_AppendResult(interp, buffer, (char *) NULL);
- if (Tk_CanvasPsColor(interp, canvas, arcPtr->fillColor) != TCL_OK) {
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
return TCL_ERROR;
};
- if (arcPtr->fillStipple != None) {
+ if (fillStipple != None) {
Tcl_AppendResult(interp, "clip ", (char *) NULL);
- if (Tk_CanvasPsStipple(interp, canvas, arcPtr->fillStipple)
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
!= TCL_OK) {
return TCL_ERROR;
}
- if (arcPtr->outlineGC != None) {
+ if (arcPtr->outline.gc != None) {
Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
}
} else {
@@ -1649,44 +1986,34 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
* If there's an outline for the arc, draw it.
*/
- if (arcPtr->outlineGC != None) {
+ 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 arc\nsetmatrix\n", ang1, ang2);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- sprintf(buffer, "%d setlinewidth\n0 setlinecap\n", arcPtr->width);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
- if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
- != TCL_OK) {
+ 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->outlineStipple != None) {
- Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
- if (Tk_CanvasPsStipple(interp, canvas,
- arcPtr->outlineStipple) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
- }
- if (arcPtr->style != arcUid) {
+ if (arcPtr->style != ARC_STYLE) {
Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
- if (arcPtr->style == chordUid) {
+ 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, arcPtr->outlineColor)
+ if (Tk_CanvasPsColor(interp, canvas, color)
!= TCL_OK) {
return TCL_ERROR;
}
- if (arcPtr->outlineStipple != None) {
+ if (stipple != None) {
Tcl_AppendResult(interp, "clip ", (char *) NULL);
if (Tk_CanvasPsStipple(interp, canvas,
- arcPtr->outlineStipple) != TCL_OK) {
+ stipple) != TCL_OK) {
return TCL_ERROR;
}
} else {
@@ -1697,14 +2024,14 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
PIE_OUTLINE2_PTS);
}
- if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
+ if (Tk_CanvasPsColor(interp, canvas, color)
!= TCL_OK) {
return TCL_ERROR;
}
- if (arcPtr->outlineStipple != None) {
+ if (stipple != None) {
Tcl_AppendResult(interp, "clip ", (char *) NULL);
if (Tk_CanvasPsStipple(interp, canvas,
- arcPtr->outlineStipple) != TCL_OK) {
+ stipple) != TCL_OK) {
return TCL_ERROR;
}
} else {
@@ -1715,3 +2042,107 @@ ArcToPostscript(interp, canvas, itemPtr, prepass)
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/tk/generic/tkCanvBmap.c b/tk/generic/tkCanvBmap.c
index 74087e2db57..dc35890505d 100644
--- a/tk/generic/tkCanvBmap.c
+++ b/tk/generic/tkCanvBmap.c
@@ -4,7 +4,7 @@
* This file implements bitmap items for canvas widgets.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -29,8 +29,14 @@ typedef struct BitmapItem {
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;
@@ -39,19 +45,42 @@ typedef struct BitmapItem {
* Information used for parsing configuration specs:
*/
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+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,
@@ -64,7 +93,7 @@ static Tk_ConfigSpec configSpecs[] = {
static int BitmapCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv));
+ Tcl_Obj *CONST argv[]));
static int BitmapToArea _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double *rectPtr));
static double BitmapToPoint _ANSI_ARGS_((Tk_Canvas canvas,
@@ -75,10 +104,10 @@ static void ComputeBitmapBbox _ANSI_ARGS_((Tk_Canvas canvas,
BitmapItem *bmapPtr));
static int ConfigureBitmap _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
-static int tkCreateBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *CONST argv[], int flags));
+static int CreateBitmap _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeleteBitmap _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayBitmap _ANSI_ARGS_((Tk_Canvas canvas,
@@ -98,13 +127,13 @@ static void TranslateBitmap _ANSI_ARGS_((Tk_Canvas canvas,
Tk_ItemType tkBitmapType = {
"bitmap", /* name */
sizeof(BitmapItem), /* itemSize */
- tkCreateBitmap, /* createProc */
+ CreateBitmap, /* createProc */
configSpecs, /* configSpecs */
ConfigureBitmap, /* configureProc */
BitmapCoords, /* coordProc */
DeleteBitmap, /* deleteProc */
DisplayBitmap, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
BitmapToPoint, /* pointProc */
BitmapToArea, /* areaProc */
BitmapToPostscript, /* postscriptProc */
@@ -115,13 +144,13 @@ Tk_ItemType tkBitmapType = {
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
(Tk_ItemInsertProc *) NULL, /* insertProc */
(Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
/*
*--------------------------------------------------------------
*
- * tkCreateBitmap --
+ * CreateBitmap --
*
* This procedure is invoked to create a new bitmap
* item in a canvas.
@@ -129,7 +158,7 @@ Tk_ItemType tkBitmapType = {
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is left uninitialized,
+ * the interp's result; in this case itemPtr is left uninitialized,
* so it can be safely freed by the caller.
*
* Side effects:
@@ -139,17 +168,30 @@ Tk_ItemType tkBitmapType = {
*/
static int
-tkCreateBitmap(interp, canvas, itemPtr, argc, argv)
+CreateBitmap(interp, canvas, itemPtr, argc, argv)
Tcl_Interp *interp; /* Interpreter for error reporting. */
Tk_Canvas canvas; /* Canvas to hold new item. */
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing rectangle. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */
{
BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int i;
+
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(argv[1], NULL);
+ if (((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z'))) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
- if (argc < 2) {
+ if (argc < i) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
itemPtr->typePtr->name, " x y ?options?\"",
@@ -163,25 +205,30 @@ tkCreateBitmap(interp, canvas, itemPtr, argc, argv)
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 ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
- != TCL_OK)) {
- return TCL_ERROR;
+ if ((BitmapCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
}
-
- if (ConfigureBitmap(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
- DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
- return TCL_ERROR;
+ if (ConfigureBitmap(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
+
+ error:
+ DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
}
/*
@@ -194,7 +241,7 @@ tkCreateBitmap(interp, canvas, itemPtr, argc, argv)
* details on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -210,26 +257,42 @@ BitmapCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
- char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
if (argc == 0) {
- Tcl_PrintDouble(interp, bmapPtr->x, x);
- Tcl_PrintDouble(interp, bmapPtr->y, y);
- Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
- } else if (argc == 2) {
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
- != TCL_OK)) {
+ 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 (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 + TCL_INTEGER_SPACE];
+
+ 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], &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1], &bmapPtr->y)
+ != TCL_OK)) {
return TCL_ERROR;
}
ComputeBitmapBbox(canvas, bmapPtr);
} else {
- sprintf(interp->result,
- "wrong # coordinates: expected 0 or 2, got %d", argc);
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
@@ -245,7 +308,7 @@ BitmapCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information may be set for itemPtr.
@@ -259,7 +322,7 @@ ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Bitmap item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
@@ -267,10 +330,14 @@ ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags)
GC newGC;
Tk_Window tkwin;
unsigned long mask;
+ XColor *fgColor;
+ XColor *bgColor;
+ Pixmap bitmap;
+ Tk_State state;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
- (char *) bmapPtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) bmapPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -279,17 +346,67 @@ ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags)
* that determine the graphics context.
*/
- gcValues.foreground = bmapPtr->fgColor->pixel;
+ 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 (bmapPtr->bgColor != NULL) {
- gcValues.background = bmapPtr->bgColor->pixel;
+ if (bgColor != NULL) {
+ gcValues.background = bgColor->pixel;
mask |= GCBackground;
} else {
- gcValues.clip_mask = bmapPtr->bitmap;
+ gcValues.clip_mask = bitmap;
mask |= GCClipMask;
}
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, bmapPtr->fgColor,
- bmapPtr->bgColor);
+ if (bitmap == None) {
+ newGC = None;
+ } else {
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
if (bmapPtr->gc != None) {
Tk_FreeGC(Tk_Display(tkwin), bmapPtr->gc);
}
@@ -329,12 +446,30 @@ DeleteBitmap(canvas, itemPtr, display)
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);
}
@@ -369,11 +504,27 @@ ComputeBitmapBbox(canvas, bmapPtr)
{
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 (bmapPtr->bitmap == None) {
+ if (state==TK_STATE_HIDDEN || bitmap == None) {
bmapPtr->header.x1 = bmapPtr->header.x2 = x;
bmapPtr->header.y1 = bmapPtr->header.y2 = y;
return;
@@ -459,6 +610,10 @@ DisplayBitmap(canvas, itemPtr, display, drawable, x, y, width, height)
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,
@@ -466,7 +621,35 @@ DisplayBitmap(canvas, itemPtr, display, drawable, x, y, width, height)
* redisplay.
*/
- if (bmapPtr->bitmap != None) {
+ 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;
@@ -502,9 +685,10 @@ DisplayBitmap(canvas, itemPtr, display, drawable, x, y, width, height)
XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX,
drawableY - bmapY);
- XCopyPlane(display, bmapPtr->bitmap, drawable,
+ XCopyPlane(display, bitmap, drawable,
bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth,
(unsigned int) bmapHeight, drawableX, drawableY, 1);
+ XSetClipOrigin(display, bmapPtr->gc, 0, 0);
}
}
@@ -691,7 +875,7 @@ TranslateBitmap(canvas, itemPtr, deltaX, deltaY)
* 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.
+ * 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.
*
@@ -716,7 +900,7 @@ BitmapToPostscript(interp, canvas, itemPtr, prepass)
double x, y;
int width, height, rowsAtOnce, rowsThisTime;
int curRow;
- char buffer[200];
+ char buffer[100 + TCL_DOUBLE_SPACE * 2 + TCL_INTEGER_SPACE * 4];
if (bmapPtr->bitmap == None) {
return TCL_OK;
@@ -750,7 +934,7 @@ BitmapToPostscript(interp, canvas, itemPtr, prepass)
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");
+ 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;
diff --git a/tk/generic/tkCanvImg.c b/tk/generic/tkCanvImg.c
index eb3df385c6b..ebfed526748 100644
--- a/tk/generic/tkCanvImg.c
+++ b/tk/generic/tkCanvImg.c
@@ -4,7 +4,7 @@
* This file implements image items for canvas widgets.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -31,23 +31,45 @@ typedef struct ImageItem {
* (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 tagsOption = {Tk_CanvasTagsParseProc,
+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,
@@ -63,19 +85,21 @@ static void ImageChangedProc _ANSI_ARGS_((ClientData clientData,
int imgHeight));
static int ImageCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv));
+ 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,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int CreateImage _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ 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,
@@ -101,10 +125,10 @@ Tk_ItemType tkImageType = {
ImageCoords, /* coordProc */
DeleteImage, /* deleteProc */
DisplayImage, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
ImageToPoint, /* pointProc */
ImageToArea, /* areaProc */
- (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */
+ ImageToPostscript, /* postscriptProc */
ScaleImage, /* scaleProc */
TranslateImage, /* translateProc */
(Tk_ItemIndexProc *) NULL, /* indexProc */
@@ -112,7 +136,7 @@ Tk_ItemType tkImageType = {
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
(Tk_ItemInsertProc *) NULL, /* insertProc */
(Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
/*
@@ -126,7 +150,7 @@ Tk_ItemType tkImageType = {
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is left uninitialized,
+ * the interp's result; in this case itemPtr is left uninitialized,
* so it can be safely freed by the caller.
*
* Side effects:
@@ -142,11 +166,24 @@ CreateImage(interp, canvas, itemPtr, argc, argv)
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing rectangle. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */
{
ImageItem *imgPtr = (ImageItem *) itemPtr;
+ int i;
- if (argc < 2) {
+ 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?\"",
@@ -161,23 +198,26 @@ CreateImage(interp, canvas, itemPtr, argc, argv)
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 ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1], &imgPtr->y)
- != TCL_OK)) {
- return TCL_ERROR;
+ if ((ImageCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
}
-
- if (ConfigureImage(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
- DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
- return TCL_ERROR;
+ if (ConfigureImage(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
+
+ error:
+ DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
}
/*
@@ -190,7 +230,7 @@ CreateImage(interp, canvas, itemPtr, argc, argv)
* details on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -206,26 +246,42 @@ ImageCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
ImageItem *imgPtr = (ImageItem *) itemPtr;
- char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
if (argc == 0) {
- Tcl_PrintDouble(interp, imgPtr->x, x);
- Tcl_PrintDouble(interp, imgPtr->y, y);
- Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
- } else if (argc == 2) {
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
- &imgPtr->y) != TCL_OK)) {
+ 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 {
- sprintf(interp->result,
- "wrong # coordinates: expected 0 or 2, got %d", argc);
+ 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;
@@ -241,7 +297,7 @@ ImageCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information may be set for itemPtr.
@@ -255,7 +311,7 @@ ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Image item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
ImageItem *imgPtr = (ImageItem *) itemPtr;
@@ -263,8 +319,8 @@ ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
Tk_Image image;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc,
- argv, (char *) imgPtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) imgPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -275,6 +331,11 @@ ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
* 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);
@@ -288,6 +349,32 @@ ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
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;
}
@@ -321,9 +408,21 @@ DeleteImage(canvas, itemPtr, display)
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);
+ }
}
/*
@@ -355,11 +454,27 @@ ComputeImageBbox(canvas, imgPtr)
{
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 (imgPtr->image == None) {
+ if ((state == TK_STATE_HIDDEN) || (image == None)) {
imgPtr->header.x1 = imgPtr->header.x2 = x;
imgPtr->header.y1 = imgPtr->header.y2 = y;
return;
@@ -369,7 +484,7 @@ ComputeImageBbox(canvas, imgPtr)
* Compute location and size of image, using anchor information.
*/
- Tk_SizeOfImage(imgPtr->image, &width, &height);
+ Tk_SizeOfImage(image, &width, &height);
switch (imgPtr->anchor) {
case TK_ANCHOR_N:
x -= width/2;
@@ -443,8 +558,25 @@ DisplayImage(canvas, itemPtr, display, drawable, x, y, width, height)
{
ImageItem *imgPtr = (ImageItem *) itemPtr;
short drawableX, drawableY;
+ Tk_Image image;
+ Tk_State state = itemPtr->state;
- if (imgPtr->image == NULL) {
+ 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;
}
@@ -454,7 +586,7 @@ DisplayImage(canvas, itemPtr, display, drawable, x, y, width, height)
Tk_CanvasDrawableCoords(canvas, (double) x, (double) y,
&drawableX, &drawableY);
- Tk_RedrawImage(imgPtr->image, x - imgPtr->header.x1, y - imgPtr->header.y1,
+ Tk_RedrawImage(image, x - imgPtr->header.x1, y - imgPtr->header.y1,
width, height, drawable, drawableX, drawableY);
}
@@ -563,6 +695,96 @@ ImageToArea(canvas, itemPtr, rectPtr)
/*
*--------------------------------------------------------------
*
+ * 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.
@@ -675,3 +897,4 @@ ImageChangedProc(clientData, x, y, width, height, imgWidth, imgHeight)
imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width),
(int) (imgPtr->header.y1 + y + height));
}
+
diff --git a/tk/generic/tkCanvLine.c b/tk/generic/tkCanvLine.c
index 2125446742d..fc2174b710b 100644
--- a/tk/generic/tkCanvLine.c
+++ b/tk/generic/tkCanvLine.c
@@ -4,7 +4,8 @@
* This file implements line items for canvas widgets.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -15,17 +16,23 @@
#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 >= 2). */
+ 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
@@ -36,14 +43,10 @@ typedef struct LineItem {
* their tips. The actual endpoints are
* stored in the *firstArrowPtr and
* *lastArrowPtr, if they exist. */
- int width; /* Width of line. */
- XColor *fg; /* Foreground color for line. */
- Pixmap fillStipple; /* Stipple bitmap for filling line. */
int capStyle; /* Cap style for line. */
int joinStyle; /* Join style for line. */
- GC gc; /* Graphics context for filling line. */
GC arrowGC; /* Graphics context for drawing arrowheads. */
- Tk_Uid arrow; /* Indicates whether or not to draw arrowheads:
+ 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
@@ -59,7 +62,7 @@ typedef struct LineItem {
* point in line (PTS_IN_ARROW points, first
* of which is tip). Malloc'ed. NULL means
* no arrowhead at last point. */
- int smooth; /* Non-zero means draw line smoothed (i.e.
+ Tk_SmoothMethod *smooth; /* Non-zero means draw line smoothed (i.e.
* with Bezier splines). */
int splineSteps; /* Number of steps in each spline segment. */
} LineItem;
@@ -81,29 +84,42 @@ static void ComputeLineBbox _ANSI_ARGS_((Tk_Canvas canvas,
LineItem *linePtr));
static int ConfigureLine _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas,
LineItem *linePtr));
static int CreateLine _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeleteLine _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayLine _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display, Drawable dst,
int x, int y, int width, int height));
+static int 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 argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
+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, char *value,
- char *recordPtr, int offset));
+ 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));
@@ -119,34 +135,101 @@ static void TranslateLine _ANSI_ARGS_((Tk_Canvas canvas,
* values in CreateLine.
*/
-static Tk_CustomOption arrowShapeOption = {ParseArrowShape,
- PrintArrowShape, (ClientData) NULL};
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+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_UID, "-arrow", (char *) NULL, (char *) NULL,
- "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT},
+ {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, fg), TK_CONFIG_NULL_OK},
+ "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_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
- "0", Tk_Offset(LineItem, smooth), 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, fillStipple), TK_CONFIG_NULL_OK},
+ (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_PIXELS, "-width", (char *) NULL, (char *) NULL,
- "1", Tk_Offset(LineItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {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}
};
@@ -165,30 +248,21 @@ Tk_ItemType tkLineType = {
LineCoords, /* coordProc */
DeleteLine, /* deleteProc */
DisplayLine, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
LineToPoint, /* pointProc */
LineToArea, /* areaProc */
LineToPostscript, /* postscriptProc */
ScaleLine, /* scaleProc */
TranslateLine, /* translateProc */
- (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemIndexProc *) GetLineIndex, /* indexProc */
(Tk_ItemCursorProc *) NULL, /* icursorProc */
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
- (Tk_ItemInsertProc *) NULL, /* insertProc */
- (Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemInsertProc *) LineInsert, /* insertProc */
+ LineDeleteCoords, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
/*
- * The Tk_Uid's below refer to uids for the various arrow types:
- */
-
-static Tk_Uid noneUid = NULL;
-static Tk_Uid firstUid = NULL;
-static Tk_Uid lastUid = NULL;
-static Tk_Uid bothUid = NULL;
-
-/*
* The definition below determines how large are static arrays
* used to hold spline points (splines larger than this have to
* have their arrays malloc-ed).
@@ -207,7 +281,7 @@ static Tk_Uid bothUid = NULL;
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is left uninitialized,
+ * the interp's result; in this case itemPtr is left uninitialized,
* so it can be safely freed by the caller.
*
* Side effects:
@@ -223,48 +297,31 @@ CreateLine(interp, canvas, itemPtr, argc, argv)
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing line. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing line. */
{
LineItem *linePtr = (LineItem *) itemPtr;
int i;
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
- itemPtr->typePtr->name, " x1 y1 x2 y2 ?x3 y3 ...? ?options?\"",
- (char *) NULL);
- return TCL_ERROR;
- }
-
/*
* Carry out initialization that is needed to set defaults and to
* allow proper cleanup after errors during the the remainder of
* this procedure.
*/
+ Tk_CreateOutline(&(linePtr->outline));
linePtr->canvas = canvas;
linePtr->numPoints = 0;
linePtr->coordPtr = NULL;
- linePtr->width = 1;
- linePtr->fg = None;
- linePtr->fillStipple = None;
linePtr->capStyle = CapButt;
linePtr->joinStyle = JoinRound;
- linePtr->gc = None;
linePtr->arrowGC = None;
- if (noneUid == NULL) {
- noneUid = Tk_GetUid("none");
- firstUid = Tk_GetUid("first");
- lastUid = Tk_GetUid("last");
- bothUid = Tk_GetUid("both");
- }
- linePtr->arrow = noneUid;
+ linePtr->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 = 0;
+ linePtr->smooth = (Tk_SmoothMethod *) NULL;
linePtr->splineSteps = 12;
/*
@@ -273,14 +330,14 @@ CreateLine(interp, canvas, itemPtr, argc, argv)
* start with a digit or a minus sign followed by a digit.
*/
- for (i = 4; i < (argc-1); i+=2) {
- if ((!isdigit(UCHAR(argv[i][0]))) &&
- ((argv[i][0] != '-')
- || ((argv[i][1] != '.') && !isdigit(UCHAR(argv[i][1]))))) {
+ for (i = 0; i < argc; i++) {
+ char *arg = Tcl_GetStringFromObj(argv[i], NULL);
+ if ((arg[0] == '-') && (arg[1] >= 'a')
+ && (arg[1] <= 'z')) {
break;
}
}
- if (LineCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ if (i && (LineCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
goto error;
}
if (ConfigureLine(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
@@ -302,7 +359,7 @@ CreateLine(interp, canvas, itemPtr, argc, argv)
* on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -318,16 +375,16 @@ LineCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
LineItem *linePtr = (LineItem *) itemPtr;
- char buffer[TCL_DOUBLE_SPACE];
int i, numPoints;
+ double *coordPtr;
if (argc == 0) {
- double *coordPtr;
int numCoords;
+ Tcl_Obj *subobj, *obj = Tcl_NewObj();
numCoords = 2*linePtr->numPoints;
if (linePtr->firstArrowPtr != NULL) {
@@ -342,35 +399,46 @@ LineCoords(interp, canvas, itemPtr, argc, argv)
if ((linePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) {
coordPtr = linePtr->lastArrowPtr;
}
- Tcl_PrintDouble(interp, *coordPtr, buffer);
- Tcl_AppendElement(interp, buffer);
+ subobj = Tcl_NewDoubleObj(*coordPtr);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
}
- } else if (argc < 4) {
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (argc == 1) {
+ if (Tcl_ListObjGetElements(interp, argv[0], &argc,
+ (Tcl_Obj ***) &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (argc & 1) {
Tcl_AppendResult(interp,
- "too few coordinates for line: must have at least 4",
+ "odd number of coordinates specified for line",
(char *) NULL);
return TCL_ERROR;
- } else if (argc & 1) {
+ } else if (argc < 4) {
Tcl_AppendResult(interp,
- "odd number of coordinates specified for line",
+ "too few coordinates specified for line",
(char *) NULL);
return TCL_ERROR;
} else {
numPoints = argc/2;
if (linePtr->numPoints != numPoints) {
+ coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * argc));
if (linePtr->coordPtr != NULL) {
ckfree((char *) linePtr->coordPtr);
}
- linePtr->coordPtr = (double *) ckalloc((unsigned)
- (sizeof(double) * argc));
+ linePtr->coordPtr = coordPtr;
linePtr->numPoints = numPoints;
}
- for (i = argc-1; i >= 0; i--) {
- if (Tk_CanvasGetCoord(interp, canvas, argv[i],
- &linePtr->coordPtr[i]) != TCL_OK) {
- return TCL_ERROR;
- }
- }
+ coordPtr = linePtr->coordPtr;
+ for (i = 0; i <argc; i++) {
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, argv[i],
+ coordPtr++) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
/*
* Update arrowheads by throwing away any existing arrow-head
@@ -385,7 +453,7 @@ LineCoords(interp, canvas, itemPtr, argc, argv)
ckfree((char *) linePtr->lastArrowPtr);
linePtr->lastArrowPtr = NULL;
}
- if (linePtr->arrow != noneUid) {
+ if (linePtr->arrow != ARROWS_NONE) {
ConfigureArrows(canvas, linePtr);
}
ComputeLineBbox(canvas, linePtr);
@@ -403,7 +471,7 @@ LineCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information, such as colors and stipple
@@ -418,7 +486,7 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Line item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
LineItem *linePtr = (LineItem *) itemPtr;
@@ -426,10 +494,11 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
GC newGC, arrowGC;
unsigned long mask;
Tk_Window tkwin;
+ Tk_State state;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
- (char *) linePtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) linePtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -438,36 +507,42 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
* graphics contexts.
*/
- if (linePtr->fg == NULL) {
- newGC = arrowGC = None;
+ 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 {
- gcValues.foreground = linePtr->fg->pixel;
- gcValues.join_style = linePtr->joinStyle;
- if (linePtr->width < 0) {
- linePtr->width = 1;
- }
- gcValues.line_width = linePtr->width;
- mask = GCForeground|GCJoinStyle|GCLineWidth;
- if (linePtr->fillStipple != None) {
- gcValues.stipple = linePtr->fillStipple;
- gcValues.fill_style = FillStippled;
- mask |= GCStipple|GCFillStyle;
- }
- if (linePtr->arrow == noneUid) {
+ 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;
}
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, linePtr->fg, NULL);
+ gcValues.join_style = linePtr->joinStyle;
+ mask |= GCJoinStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
gcValues.line_width = 0;
- arrowGC = Tk_GetGCColor(tkwin, mask, &gcValues, linePtr->fg, NULL);
+ arrowGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = arrowGC = None;
}
- if (linePtr->gc != None) {
- Tk_FreeGC(Tk_Display(tkwin), linePtr->gc);
+ 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->gc = newGC;
+ linePtr->outline.gc = newGC;
linePtr->arrowGC = arrowGC;
/*
@@ -480,21 +555,26 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
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 != firstUid)
- && (linePtr->arrow != bothUid)) {
+ 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 != lastUid)
- && (linePtr->arrow != bothUid)) {
+ if ((linePtr->lastArrowPtr != NULL) && (linePtr->arrow != ARROWS_LAST)
+ && (linePtr->arrow != ARROWS_BOTH)) {
int i;
i = 2*(linePtr->numPoints-1);
@@ -503,15 +583,7 @@ ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
ckfree((char *) linePtr->lastArrowPtr);
linePtr->lastArrowPtr = NULL;
}
- if (linePtr->arrow != noneUid) {
- if ((linePtr->arrow != firstUid) && (linePtr->arrow != lastUid)
- && (linePtr->arrow != bothUid)) {
- Tcl_AppendResult(interp, "bad arrow spec \"",
- linePtr->arrow, "\": must be none, first, last, or both",
- (char *) NULL);
- linePtr->arrow = noneUid;
- return TCL_ERROR;
- }
+ if (linePtr->arrow != ARROWS_NONE) {
ConfigureArrows(canvas, linePtr);
}
@@ -550,18 +622,10 @@ DeleteLine(canvas, itemPtr, display)
{
LineItem *linePtr = (LineItem *) itemPtr;
+ Tk_DeleteOutline(display, &(linePtr->outline));
if (linePtr->coordPtr != NULL) {
ckfree((char *) linePtr->coordPtr);
}
- if (linePtr->fg != NULL) {
- Tk_FreeColor(linePtr->fg);
- }
- if (linePtr->fillStipple != None) {
- Tk_FreeBitmap(display, linePtr->fillStipple);
- }
- if (linePtr->gc != None) {
- Tk_FreeGC(display, linePtr->gc);
- }
if (linePtr->arrowGC != None) {
Tk_FreeGC(display, linePtr->arrowGC);
}
@@ -598,7 +662,33 @@ ComputeLineBbox(canvas, linePtr)
* recomputed. */
{
double *coordPtr;
- int i, width;
+ 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;
@@ -618,14 +708,66 @@ ComputeLineBbox(canvas, linePtr)
i++, coordPtr += 2) {
TkIncludePoint((Tk_Item *) linePtr, coordPtr);
}
- width = linePtr->width;
- if (width < 1) {
- width = 1;
+ 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;
}
- linePtr->header.x1 -= width;
- linePtr->header.x2 += width;
- linePtr->header.y1 -= width;
- linePtr->header.y2 += width;
/*
* For mitered lines, make a second pass through all the points.
@@ -640,7 +782,7 @@ ComputeLineBbox(canvas, linePtr)
int j;
if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
- (double) width, miter, miter+2)) {
+ width, miter, miter+2)) {
for (j = 0; j < 4; j += 2) {
TkIncludePoint((Tk_Item *) linePtr, miter+j);
}
@@ -652,14 +794,14 @@ ComputeLineBbox(canvas, linePtr)
* Add in the sizes of arrowheads, if any.
*/
- if (linePtr->arrow != noneUid) {
- if (linePtr->arrow != lastUid) {
+ 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 != firstUid) {
+ if (linePtr->arrow != ARROWS_FIRST) {
for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
i++, coordPtr += 2) {
TkIncludePoint((Tk_Item *) linePtr, coordPtr);
@@ -710,13 +852,34 @@ DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
XPoint staticPoints[MAX_STATIC_POINTS];
XPoint *pointPtr;
XPoint *pPtr;
- double *coordPtr;
+ double *coordPtr, linewidth;
int i, numPoints;
+ Tk_State state = itemPtr->state;
+ Pixmap stipple = linePtr->outline.stipple;
- if (linePtr->gc == None) {
+ 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.activeWidth;
+ }
+ }
/*
* Build up an array of points in screen coordinates. Use a
* static array unless the line has an enormous number of points;
@@ -725,7 +888,9 @@ DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
*/
if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
- numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ numPoints = linePtr->smooth->coordProc(canvas, (double *) NULL,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
} else {
numPoints = linePtr->numPoints;
}
@@ -737,7 +902,7 @@ DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
}
if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
- numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
linePtr->numPoints, linePtr->splineSteps, pointPtr,
(double *) NULL);
} else {
@@ -755,12 +920,21 @@ DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
* GC is supposed to be read-only.
*/
- if (linePtr->fillStipple != None) {
- Tk_CanvasSetStippleOrigin(canvas, linePtr->gc);
- Tk_CanvasSetStippleOrigin(canvas, linePtr->arrowGC);
+ if (Tk_ChangeOutlineGC(canvas, itemPtr, &(linePtr->outline))) {
+ Tk_CanvasSetOffset(canvas, linePtr->arrowGC, &linePtr->outline.tsoffset);
}
- XDrawLines(display, drawable, linePtr->gc, pointPtr, numPoints,
+ 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);
}
@@ -771,14 +945,13 @@ DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
if (linePtr->firstArrowPtr != NULL) {
TkFillPolygon(canvas, linePtr->firstArrowPtr, PTS_IN_ARROW,
- display, drawable, linePtr->gc, NULL);
+ display, drawable, linePtr->arrowGC, NULL);
}
if (linePtr->lastArrowPtr != NULL) {
TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW,
- display, drawable, linePtr->gc, NULL);
+ display, drawable, linePtr->arrowGC, NULL);
}
- if (linePtr->fillStipple != None) {
- XSetTSOrigin(display, linePtr->gc, 0, 0);
+ if (Tk_ResetOutlineGC(canvas, itemPtr, &(linePtr->outline))) {
XSetTSOrigin(display, linePtr->arrowGC, 0, 0);
}
}
@@ -786,6 +959,325 @@ DisplayLine(canvas, itemPtr, display, drawable, x, y, width, height)
/*
*--------------------------------------------------------------
*
+ * 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, argc, 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, &argc, &objv) != TCL_OK)
+ || !argc || argc&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 + argc)));
+ for(i=0; i<beforeThis; i++) {
+ new[i] = linePtr->coordPtr[i];
+ }
+ for(i=0; i<argc; 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+argc] = linePtr->coordPtr[i];
+ }
+ if(linePtr->coordPtr) ckfree((char *)linePtr->coordPtr);
+ linePtr->coordPtr = new;
+ linePtr->numPoints = (length + argc)/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; argc+=2; }
+ if ((beforeThis+argc)<length) argc+=2;
+ if (linePtr->smooth) {
+ if(beforeThis>0) {
+ beforeThis-=2; argc+=2;
+ }
+ if((beforeThis+argc+2)<length) {
+ argc+=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+argc)>=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<argc; 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+argc)<(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
@@ -810,11 +1302,12 @@ LineToPoint(canvas, itemPtr, pointPtr)
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;
+ double bestDist, dist, width;
int numPoints, count;
int changedMiterToBevel; /* Non-zero means that a mitered corner
* had to be treated as beveled after all
@@ -827,15 +1320,32 @@ LineToPoint(canvas, itemPtr, pointPtr)
* 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 = 1 + linePtr->numPoints*linePtr->splineSteps;
+ 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 = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
linePoints);
} else {
@@ -843,6 +1353,19 @@ LineToPoint(canvas, itemPtr, pointPtr)
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
@@ -863,7 +1386,7 @@ LineToPoint(canvas, itemPtr, pointPtr)
|| ((linePtr->joinStyle == JoinRound)
&& (count != numPoints))) {
dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
- - linePtr->width/2.0;
+ - width/2.0;
if (dist <= 0.0) {
bestDist = 0.0;
goto done;
@@ -879,7 +1402,7 @@ LineToPoint(canvas, itemPtr, pointPtr)
*/
if (count == numPoints) {
- TkGetButtPoints(coordPtr+2, coordPtr, (double) linePtr->width,
+ TkGetButtPoints(coordPtr+2, coordPtr, width,
linePtr->capStyle == CapProjecting, poly, poly+2);
} else if ((linePtr->joinStyle == JoinMiter) && !changedMiterToBevel) {
poly[0] = poly[6];
@@ -887,7 +1410,7 @@ LineToPoint(canvas, itemPtr, pointPtr)
poly[2] = poly[4];
poly[3] = poly[5];
} else {
- TkGetButtPoints(coordPtr+2, coordPtr, (double) linePtr->width, 0,
+ TkGetButtPoints(coordPtr+2, coordPtr, width, 0,
poly, poly+2);
/*
@@ -911,17 +1434,17 @@ LineToPoint(canvas, itemPtr, pointPtr)
}
}
if (count == 2) {
- TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width,
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
linePtr->capStyle == CapProjecting, poly+4, poly+6);
} else if (linePtr->joinStyle == JoinMiter) {
if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
- (double) linePtr->width, poly+4, poly+6) == 0) {
+ width, poly+4, poly+6) == 0) {
changedMiterToBevel = 1;
- TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width,
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
0, poly+4, poly+6);
}
} else {
- TkGetButtPoints(coordPtr, coordPtr+2, (double) linePtr->width, 0,
+ TkGetButtPoints(coordPtr, coordPtr+2, width, 0,
poly+4, poly+6);
}
poly[8] = poly[0];
@@ -942,7 +1465,7 @@ LineToPoint(canvas, itemPtr, pointPtr)
if (linePtr->capStyle == CapRound) {
dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
- - linePtr->width/2.0;
+ - width/2.0;
if (dist <= 0.0) {
bestDist = 0.0;
goto done;
@@ -955,8 +1478,8 @@ LineToPoint(canvas, itemPtr, pointPtr)
* If there are arrowheads, check the distance to the arrowheads.
*/
- if (linePtr->arrow != noneUid) {
- if (linePtr->arrow != lastUid) {
+ if (linePtr->arrow != ARROWS_NONE) {
+ if (linePtr->arrow != ARROWS_LAST) {
dist = TkPolygonToPoint(linePtr->firstArrowPtr, PTS_IN_ARROW,
pointPtr);
if (dist <= 0.0) {
@@ -966,7 +1489,7 @@ LineToPoint(canvas, itemPtr, pointPtr)
bestDist = dist;
}
}
- if (linePtr->arrow != firstUid) {
+ if (linePtr->arrow != ARROWS_FIRST) {
dist = TkPolygonToPoint(linePtr->lastArrowPtr, PTS_IN_ARROW,
pointPtr);
if (dist <= 0.0) {
@@ -1016,6 +1539,35 @@ LineToArea(canvas, itemPtr, rectPtr)
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
@@ -1023,14 +1575,16 @@ LineToArea(canvas, itemPtr, rectPtr)
*/
if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
- numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ 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 = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
linePoints);
} else {
@@ -1042,8 +1596,12 @@ LineToArea(canvas, itemPtr, rectPtr)
* Check the segments of the line.
*/
+ if (width < 1.0) {
+ width = 1.0;
+ }
+
result = TkThickPolyLineToArea(linePoints, numPoints,
- (double) linePtr->width, linePtr->capStyle, linePtr->joinStyle,
+ width, linePtr->capStyle, linePtr->joinStyle,
rectPtr);
if (result == 0) {
goto done;
@@ -1053,15 +1611,15 @@ LineToArea(canvas, itemPtr, rectPtr)
* Check arrowheads, if any.
*/
- if (linePtr->arrow != noneUid) {
- if (linePtr->arrow != lastUid) {
+ 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 != firstUid) {
+ if (linePtr->arrow != ARROWS_FIRST) {
if (TkPolygonToArea(linePtr->lastArrowPtr, PTS_IN_ARROW,
rectPtr) != result) {
result = 0;
@@ -1134,7 +1692,7 @@ ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY)
coordPtr[0] = originX + scaleX*(*coordPtr - originX);
coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
}
- if (linePtr->arrow != noneUid) {
+ if (linePtr->arrow != ARROWS_NONE) {
ConfigureArrows(canvas, linePtr);
}
ComputeLineBbox(canvas, linePtr);
@@ -1143,6 +1701,96 @@ ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY)
/*
*--------------------------------------------------------------
*
+ * 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.
@@ -1216,7 +1864,7 @@ ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Used for error reporting. */
Tk_Window tkwin; /* Not used. */
- char *value; /* Textual specification of arrow shape. */
+ 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
@@ -1231,7 +1879,7 @@ ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset)
panic("ParseArrowShape received bogus offset");
}
- if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ if (Tcl_SplitList(interp, (char *) value, &argc, &argv) != TCL_OK) {
syntaxError:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad arrow shape \"", value,
@@ -1296,6 +1944,117 @@ PrintArrowShape(clientData, tkwin, recordPtr, offset, freeProcPtr)
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";
+ }
+}
+
/*
*--------------------------------------------------------------
*
@@ -1335,6 +2094,27 @@ ConfigureArrows(canvas, linePtr)
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
@@ -1345,7 +2125,7 @@ ConfigureArrows(canvas, linePtr)
shapeA = linePtr->arrowShapeA + 0.001;
shapeB = linePtr->arrowShapeB + 0.001;
- shapeC = linePtr->arrowShapeC + linePtr->width/2.0 + 0.001;
+ shapeC = linePtr->arrowShapeC + width/2.0 + 0.001;
/*
* If there's an arrowhead on the first point of the line, compute
@@ -1353,9 +2133,9 @@ ConfigureArrows(canvas, linePtr)
* line doesn't stick out past the leading edge of the arrowhead.
*/
- fracHeight = (linePtr->width/2.0)/shapeC;
+ fracHeight = (width/2.0)/shapeC;
backup = fracHeight*shapeB + shapeA*(1.0 - fracHeight)/2.0;
- if (linePtr->arrow != lastUid) {
+ if (linePtr->arrow != ARROWS_LAST) {
poly = linePtr->firstArrowPtr;
if (poly == NULL) {
poly = (double *) ckalloc((unsigned)
@@ -1400,7 +2180,7 @@ ConfigureArrows(canvas, linePtr)
* Similar arrowhead calculation for the last point of the line.
*/
- if (linePtr->arrow != firstUid) {
+ if (linePtr->arrow != ARROWS_FIRST) {
coordPtr = linePtr->coordPtr + 2*(linePtr->numPoints-2);
poly = linePtr->lastArrowPtr;
if (poly == NULL) {
@@ -1449,7 +2229,7 @@ ConfigureArrows(canvas, linePtr)
* 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
+ * 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.
*
@@ -1471,24 +2251,78 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
* final Postscript is being created. */
{
LineItem *linePtr = (LineItem *) itemPtr;
- char buffer[200];
+ char buffer[64 + TCL_INTEGER_SPACE];
char *style;
- if (linePtr->fg == NULL) {
+ 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 <= 2)) {
+ if ((!linePtr->smooth) || (linePtr->numPoints < 3)) {
Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints);
} else {
- if (linePtr->fillStipple == None) {
- TkMakeBezierPostscript(interp, canvas, linePtr->coordPtr,
- linePtr->numPoints);
+ 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
@@ -1503,13 +2337,15 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
double *pointPtr;
int numPoints;
- numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ 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 = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ numPoints = linePtr->smooth->coordProc(canvas, linePtr->coordPtr,
linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
pointPtr);
Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints);
@@ -1523,8 +2359,6 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
* Set other line-drawing parameters and stroke out the line.
*/
- sprintf(buffer, "%d setlinewidth\n", linePtr->width);
- Tcl_AppendResult(interp, buffer, (char *) NULL);
style = "0 setlinecap\n";
if (linePtr->capStyle == CapRound) {
style = "1 setlinecap\n";
@@ -1539,17 +2373,10 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
style = "2 setlinejoin\n";
}
Tcl_AppendResult(interp, style, (char *) NULL);
- if (Tk_CanvasPsColor(interp, canvas, linePtr->fg) != TCL_OK) {
+
+ if (Tk_CanvasPsOutline(canvas, itemPtr,
+ &(linePtr->outline)) != TCL_OK) {
return TCL_ERROR;
- };
- if (linePtr->fillStipple != None) {
- Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
- if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple)
- != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
- Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
}
/*
@@ -1557,7 +2384,7 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
*/
if (linePtr->firstArrowPtr != NULL) {
- if (linePtr->fillStipple != None) {
+ if (stipple != None) {
Tcl_AppendResult(interp, "grestore gsave\n",
(char *) NULL);
}
@@ -1567,7 +2394,7 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
}
}
if (linePtr->lastArrowPtr != NULL) {
- if (linePtr->fillStipple != None) {
+ if (stipple != None) {
Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
}
if (ArrowheadPostscript(interp, canvas, linePtr,
@@ -1589,7 +2416,7 @@ LineToPostscript(interp, canvas, itemPtr, prepass)
* 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
+ * 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.
*
@@ -1609,10 +2436,28 @@ ArrowheadPostscript(interp, canvas, linePtr, arrowPtr)
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 (linePtr->fillStipple != None) {
+ if (stipple != None) {
Tcl_AppendResult(interp, "clip ", (char *) NULL);
- if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple)
+ if (Tk_CanvasPsStipple(interp, canvas, stipple)
!= TCL_OK) {
return TCL_ERROR;
}
@@ -1621,3 +2466,4 @@ ArrowheadPostscript(interp, canvas, linePtr, arrowPtr)
}
return TCL_OK;
}
+
diff --git a/tk/generic/tkCanvPoly.c b/tk/generic/tkCanvPoly.c
index 79c7b6c50b4..60616e173b9 100644
--- a/tk/generic/tkCanvPoly.c
+++ b/tk/generic/tkCanvPoly.c
@@ -5,6 +5,7 @@
*
* 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.
@@ -15,6 +16,7 @@
#include <stdio.h>
#include "tkInt.h"
#include "tkPort.h"
+#include "tkCanvas.h"
/*
* The structure below defines the record for each polygon item.
@@ -23,7 +25,8 @@
typedef struct PolygonItem {
Tk_Item header; /* Generic stuff that's the same for all
* types. MUST BE FIRST IN STRUCTURE. */
- int numPoints; /* Number of points in polygon (always >= 3).
+ 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. */
@@ -31,13 +34,16 @@ typedef struct PolygonItem {
* x- and y-coords of all points in polygon.
* X-coords are even-valued indices, y-coords
* are corresponding odd-valued indices. */
- int width; /* Width of outline. */
- XColor *outlineColor; /* Color for outline. */
- GC outlineGC; /* Graphics context for drawing outline. */
+ 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. */
- int smooth; /* Non-zero means draw shape smoothed (i.e.
+ 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,
@@ -48,25 +54,106 @@ typedef struct PolygonItem {
* Information used for parsing configuration specs:
*/
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+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, outlineColor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
- "0", Tk_Offset(PolygonItem, smooth), TK_CONFIG_DONT_SET_DEFAULT},
+ (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_PIXELS, "-width", (char *) NULL, (char *) NULL,
- "1", Tk_Offset(PolygonItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {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}
};
@@ -79,18 +166,25 @@ static void ComputePolygonBbox _ANSI_ARGS_((Tk_Canvas canvas,
PolygonItem *polyPtr));
static int ConfigurePolygon _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeletePolygon _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayPolygon _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display, Drawable dst,
int x, int y, int width, int height));
+static int 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 argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
+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,
@@ -117,18 +211,18 @@ Tk_ItemType tkPolygonType = {
PolygonCoords, /* coordProc */
DeletePolygon, /* deleteProc */
DisplayPolygon, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
PolygonToPoint, /* pointProc */
PolygonToArea, /* areaProc */
PolygonToPostscript, /* postscriptProc */
ScalePolygon, /* scaleProc */
TranslatePolygon, /* translateProc */
- (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemIndexProc *) GetPolygonIndex,/* indexProc */
(Tk_ItemCursorProc *) NULL, /* icursorProc */
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
- (Tk_ItemInsertProc *) NULL, /* insertProc */
- (Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemInsertProc *) PolygonInsert,/* insertProc */
+ PolygonDeleteCoords, /* dTextProc */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
/*
@@ -150,7 +244,7 @@ Tk_ItemType tkPolygonType = {
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is
+ * the interp's result; in this case itemPtr is
* left uninitialized, so it can be safely freed by the
* caller.
*
@@ -167,34 +261,32 @@ CreatePolygon(interp, canvas, itemPtr, argc, argv)
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing polygon. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing polygon. */
{
PolygonItem *polyPtr = (PolygonItem *) itemPtr;
int i;
- if (argc < 6) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
- itemPtr->typePtr->name,
- " x1 y1 x2 y2 x3 y3 ?x4 y4 ...? ?options?\"", (char *) NULL);
- return TCL_ERROR;
- }
-
/*
* Carry out initialization that is needed in order to clean
* up after errors during the the remainder of this procedure.
*/
+ Tk_CreateOutline(&(polyPtr->outline));
polyPtr->numPoints = 0;
polyPtr->pointsAllocated = 0;
polyPtr->coordPtr = NULL;
- polyPtr->width = 1;
- polyPtr->outlineColor = NULL;
- polyPtr->outlineGC = None;
+ 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 = 0;
+ polyPtr->smooth = (Tk_SmoothMethod *) NULL;
polyPtr->splineSteps = 12;
polyPtr->autoClosed = 0;
@@ -204,13 +296,14 @@ CreatePolygon(interp, canvas, itemPtr, argc, argv)
* start with a digit or a minus sign followed by a digit.
*/
- for (i = 4; i < (argc-1); i+=2) {
- if ((!isdigit(UCHAR(argv[i][0]))) &&
- ((argv[i][0] != '-') || (!isdigit(UCHAR(argv[i][1]))))) {
+ for (i = 0; i < argc; i++) {
+ char *arg = Tcl_GetStringFromObj((Tcl_Obj *) argv[i], NULL);
+ if ((arg[0] == '-') && (arg[1] >= 'a')
+ && (arg[1] <= 'z')) {
break;
}
}
- if (PolygonCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ if (i && PolygonCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
goto error;
}
@@ -234,7 +327,7 @@ CreatePolygon(interp, canvas, itemPtr, argc, argv)
* on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -250,11 +343,10 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
PolygonItem *polyPtr = (PolygonItem *) itemPtr;
- char buffer[TCL_DOUBLE_SPACE];
int i, numPoints;
if (argc == 0) {
@@ -262,16 +354,21 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv)
* 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++) {
- Tcl_PrintDouble(interp, polyPtr->coordPtr[i], buffer);
- Tcl_AppendElement(interp, buffer);
+ subobj = Tcl_NewDoubleObj(polyPtr->coordPtr[i]);
+ Tcl_ListObjAppendElement(interp, obj, subobj);
}
- } else if (argc < 6) {
- Tcl_AppendResult(interp,
- "too few coordinates for polygon: must have at least 6",
- (char *) NULL);
- return TCL_ERROR;
- } else if (argc & 1) {
+ Tcl_SetObjResult(interp, obj);
+ return TCL_OK;
+ }
+ if (argc == 1) {
+ if (Tcl_ListObjGetElements(interp, argv[0], &argc,
+ (Tcl_Obj ***) &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (argc & 1) {
Tcl_AppendResult(interp,
"odd number of coordinates specified for polygon",
(char *) NULL);
@@ -284,8 +381,8 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv)
}
/*
- * One extra point gets allocated here, just in case we have
- * to add another point to close the polygon.
+ * One extra point gets allocated here, because we always
+ * add another point to close the polygon.
*/
polyPtr->coordPtr = (double *) ckalloc((unsigned)
@@ -293,20 +390,20 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv)
polyPtr->pointsAllocated = numPoints+1;
}
for (i = argc-1; i >= 0; i--) {
- if (Tk_CanvasGetCoord(interp, canvas, argv[i],
+ if (Tk_CanvasGetCoordFromObj(interp, canvas, argv[i],
&polyPtr->coordPtr[i]) != TCL_OK) {
return TCL_ERROR;
}
}
polyPtr->numPoints = numPoints;
polyPtr->autoClosed = 0;
-
+
/*
* Close the polygon if it isn't already closed.
*/
- if ((polyPtr->coordPtr[argc-2] != polyPtr->coordPtr[0])
- || (polyPtr->coordPtr[argc-1] != polyPtr->coordPtr[1])) {
+ if (argc>2 && ((polyPtr->coordPtr[argc-2] != polyPtr->coordPtr[0])
+ || (polyPtr->coordPtr[argc-1] != polyPtr->coordPtr[1]))) {
polyPtr->autoClosed = 1;
polyPtr->numPoints++;
polyPtr->coordPtr[argc] = polyPtr->coordPtr[0];
@@ -327,7 +424,7 @@ PolygonCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information, such as colors and stipple
@@ -342,7 +439,7 @@ ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Polygon item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
PolygonItem *polyPtr = (PolygonItem *) itemPtr;
@@ -350,10 +447,13 @@ ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags)
GC newGC;
unsigned long mask;
Tk_Window tkwin;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
- (char *) polyPtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) polyPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -362,37 +462,70 @@ ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags)
* graphics contexts.
*/
- if (polyPtr->width < 1) {
- polyPtr->width = 1;
- }
- if (polyPtr->outlineColor == NULL) {
- newGC = None;
+ 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 {
- gcValues.foreground = polyPtr->outlineColor->pixel;
- gcValues.line_width = polyPtr->width;
+ 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 = JoinRound;
- mask = GCForeground|GCLineWidth|GCCapStyle|GCJoinStyle;
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, polyPtr->outlineColor,
- NULL);
+ 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);
}
- if (polyPtr->outlineGC != None) {
- Tk_FreeGC(Tk_Display(tkwin), polyPtr->outlineGC);
+ 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;
+ }
}
- polyPtr->outlineGC = newGC;
- if (polyPtr->fillColor == NULL) {
+ if (color == NULL) {
newGC = None;
} else {
- gcValues.foreground = polyPtr->fillColor->pixel;
+ gcValues.foreground = color->pixel;
mask = GCForeground;
- if (polyPtr->fillStipple != None) {
- gcValues.stipple = polyPtr->fillStipple;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
gcValues.fill_style = FillStippled;
mask |= GCStipple|GCFillStyle;
}
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, polyPtr->fillColor,
- NULL);
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
}
if (polyPtr->fillGC != None) {
Tk_FreeGC(Tk_Display(tkwin), polyPtr->fillGC);
@@ -439,20 +572,27 @@ DeletePolygon(canvas, itemPtr, display)
{
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->outlineColor != NULL) {
- Tk_FreeColor(polyPtr->outlineColor);
+ if (polyPtr->activeFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->activeFillStipple);
}
- if (polyPtr->outlineGC != None) {
- Tk_FreeGC(display, polyPtr->outlineGC);
+ if (polyPtr->disabledFillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->disabledFillStipple);
}
if (polyPtr->fillGC != None) {
Tk_FreeGC(display, polyPtr->fillGC);
@@ -485,27 +625,159 @@ ComputePolygonBbox(canvas, polyPtr)
{
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];
- for (i = 1, coordPtr = polyPtr->coordPtr+2; i < polyPtr->numPoints;
+ /*
+ * 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);
+ }
+ }
+ }
+ }
+ }
+
/*
- * Expand bounding box in all directions to account for the outline,
- * which can stick out beyond the polygon. Add one extra pixel of
- * fudge, just in case X rounds differently than we do.
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
*/
- i = (polyPtr->width+1)/2 + 1;
- polyPtr->header.x1 -= i;
- polyPtr->header.x2 += i;
- polyPtr->header.y1 -= i;
- polyPtr->header.y2 += i;
+ polyPtr->header.x1 -= 1;
+ polyPtr->header.x2 += 1;
+ polyPtr->header.y1 -= 1;
+ polyPtr->header.y2 += 1;
}
/*
@@ -569,7 +841,7 @@ TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC)
* allocated.
*/
- if (gc != None) {
+ if (gc != None && numPoints>3) {
XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex,
CoordModeOrigin);
}
@@ -611,24 +883,80 @@ DisplayPolygon(canvas, itemPtr, display, drawable, x, y, width, height)
* 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->outlineGC == None)) {
+ 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 ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) {
- Tk_CanvasSetStippleOrigin(canvas, polyPtr->fillGC);
+ 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->smooth) {
+ 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->outlineGC);
+ display, drawable, polyPtr->fillGC, polyPtr->outline.gc);
} else {
int numPoints;
XPoint staticPoints[MAX_STATIC_POINTS];
@@ -639,29 +967,32 @@ DisplayPolygon(canvas, itemPtr, display, drawable, x, y, width, height)
* spline points rather than the original points.
*/
- numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ 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 = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ 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->outlineGC != None) {
- XDrawLines(display, drawable, polyPtr->outlineGC, pointPtr,
+ if (polyPtr->outline.gc != None) {
+ XDrawLines(display, drawable, polyPtr->outline.gc, pointPtr,
numPoints, CoordModeOrigin);
}
if (pointPtr != staticPoints) {
ckfree((char *) pointPtr);
}
}
- if ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) {
+ Tk_ResetOutlineGC(canvas, itemPtr, &(polyPtr->outline));
+ if ((stipple != None) && (polyPtr->fillGC != None)) {
XSetTSOrigin(display, polyPtr->fillGC, 0, 0);
}
}
@@ -669,6 +1000,203 @@ DisplayPolygon(canvas, itemPtr, display, drawable, x, y, width, height)
/*
*--------------------------------------------------------------
*
+ * 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, argc, 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, &argc, &objv) != TCL_OK)
+ || !argc || argc&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 + argc)));
+ for (i=0; i<beforeThis; i++) {
+ new[i] = polyPtr->coordPtr[i];
+ }
+ for (i=0; i<argc; 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+argc] = polyPtr->coordPtr[i];
+ }
+ if(polyPtr->coordPtr) ckfree((char *) polyPtr->coordPtr);
+ length+=argc;
+ 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-argc)>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; argc+=4;
+ if(polyPtr->smooth) {
+ beforeThis-=2; argc+=4;
+ } /* be carefull; beforeThis could now be negative */
+ for(i=beforeThis; i<beforeThis+argc; 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
@@ -694,41 +1222,169 @@ PolygonToPoint(canvas, itemPtr, pointPtr)
double *pointPtr; /* Pointer to x and y coordinates. */
{
PolygonItem *polyPtr = (PolygonItem *) itemPtr;
- double *coordPtr, distance;
+ double *coordPtr, *polyPoints;
double staticSpace[2*MAX_STATIC_POINTS];
- int numPoints;
+ 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;
- if (!polyPtr->smooth) {
- distance = TkPolygonToPoint(polyPtr->coordPtr, polyPtr->numPoints,
- pointPtr);
- } else {
- /*
- * Smoothed polygon. Generate a new set of points and use them
- * for comparison.
- */
-
- numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ /*
+ * 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) {
- coordPtr = staticSpace;
+ polyPoints = staticSpace;
} else {
- coordPtr = (double *) ckalloc((unsigned)
+ polyPoints = (double *) ckalloc((unsigned)
(2*numPoints*sizeof(double)));
}
- numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
- coordPtr);
- distance = TkPolygonToPoint(coordPtr, numPoints, pointPtr);
- if (coordPtr != staticSpace) {
- ckfree((char *) coordPtr);
+ 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->outlineColor != NULL) {
- distance -= polyPtr->width/2.0;
- if (distance < 0) {
- distance = 0;
+
+ 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 distance;
+ return bestDist;
}
/*
@@ -761,75 +1417,179 @@ PolygonToArea(canvas, itemPtr, rectPtr)
* area. */
{
PolygonItem *polyPtr = (PolygonItem *) itemPtr;
- double *coordPtr, rect2[4], halfWidth;
+ double *coordPtr;
double staticSpace[2*MAX_STATIC_POINTS];
- int numPoints, result;
+ 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 = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ numPoints = polyPtr->smooth->coordProc(canvas, (double *) NULL,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ (double *) NULL);
if (numPoints <= MAX_STATIC_POINTS) {
- coordPtr = staticSpace;
+ polyPoints = staticSpace;
} else {
- coordPtr = (double *) ckalloc((unsigned)
+ polyPoints = (double *) ckalloc((unsigned)
(2*numPoints*sizeof(double)));
}
- numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ numPoints = polyPtr->smooth->coordProc(canvas, polyPtr->coordPtr,
polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
- coordPtr);
+ polyPoints);
} else {
numPoints = polyPtr->numPoints;
- coordPtr = polyPtr->coordPtr;
+ polyPoints = polyPtr->coordPtr;
}
- if (polyPtr->width <= 1) {
- /*
- * The outline of the polygon doesn't stick out, so we can
- * do a simple check.
- */
-
- result = TkPolygonToArea(coordPtr, numPoints, rectPtr);
+ if (polyPtr->fillGC != None) {
+ inside = TkPolygonToArea(polyPoints, numPoints, rectPtr);
+ if (inside==0) goto donearea;
} else {
+ if ((polyPoints[0] >= rectPtr[0])
+ && (polyPoints[0] <= rectPtr[2])
+ && (polyPoints[1] >= rectPtr[1])
+ && (polyPoints[1] <= rectPtr[3])) {
+ inside = 1;
+ }
+ }
+
+ 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) {
+
/*
- * The polygon has a wide outline, so the check is more complicated.
- * First, check the line segments to see if they overlap the area.
+ * If rounding is done around the first point of the edge
+ * then test a circular region around the point with the
+ * area.
*/
- result = TkThickPolyLineToArea(coordPtr, numPoints,
- (double) polyPtr->width, CapRound, JoinRound, rectPtr);
- if (result >= 0) {
- goto done;
+ 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;
+ }
}
/*
- * There is no overlap between the polygon's outline and the
- * rectangle. This means either the rectangle is entirely outside
- * the polygon or entirely inside. To tell the difference,
- * see whether the polygon (with 0 outline width) overlaps the
- * rectangle bloated by half the outline width.
+ * 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.
*/
- halfWidth = polyPtr->width/2.0;
- rect2[0] = rectPtr[0] - halfWidth;
- rect2[1] = rectPtr[1] - halfWidth;
- rect2[2] = rectPtr[2] + halfWidth;
- rect2[3] = rectPtr[3] + halfWidth;
- if (TkPolygonToArea(coordPtr, numPoints, rect2) == -1) {
- result = -1;
+ 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 {
- result = 0;
+ 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;
}
}
- done:
- if ((coordPtr != staticSpace) && (coordPtr != polyPtr->coordPtr)) {
- ckfree((char *) coordPtr);
+ donearea:
+ if ((polyPoints != staticSpace) && (polyPoints != polyPtr->coordPtr)) {
+ ckfree((char *) polyPoints);
}
- return result;
+ return inside;
}
/*
@@ -875,6 +1635,101 @@ ScalePolygon(canvas, itemPtr, originX, originY, scaleX, scaleY)
/*
*--------------------------------------------------------------
*
+ * 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
@@ -921,7 +1776,7 @@ TranslatePolygon(canvas, itemPtr, deltaX, deltaY)
* 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
+ * 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.
*
@@ -942,31 +1797,104 @@ PolygonToPostscript(interp, canvas, itemPtr, prepass)
* collect font information; 0 means
* final Postscript is being created. */
{
- char string[100];
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 (polyPtr->fillColor != NULL) {
- if (!polyPtr->smooth) {
+ if (fillColor != NULL && polyPtr->numPoints>3) {
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
polyPtr->numPoints);
} else {
- TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
- polyPtr->numPoints);
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
}
- if (Tk_CanvasPsColor(interp, canvas, polyPtr->fillColor) != TCL_OK) {
+ if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
return TCL_ERROR;
}
- if (polyPtr->fillStipple != None) {
+ if (fillStipple != None) {
Tcl_AppendResult(interp, "eoclip ", (char *) NULL);
- if (Tk_CanvasPsStipple(interp, canvas, polyPtr->fillStipple)
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
!= TCL_OK) {
return TCL_ERROR;
}
- if (polyPtr->outlineColor != NULL) {
+ if (color != NULL) {
Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
}
} else {
@@ -978,23 +1906,31 @@ PolygonToPostscript(interp, canvas, itemPtr, prepass)
* Now draw the outline, if there is one.
*/
- if (polyPtr->outlineColor != NULL) {
- if (!polyPtr->smooth) {
+ if (color != NULL) {
+
+ if (!polyPtr->smooth || !polyPtr->smooth->postscriptProc) {
Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
polyPtr->numPoints);
} else {
- TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
- polyPtr->numPoints);
+ polyPtr->smooth->postscriptProc(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps);
}
- sprintf(string, "%d setlinewidth\n", polyPtr->width);
- Tcl_AppendResult(interp, string,
- "1 setlinecap\n1 setlinejoin\n", (char *) NULL);
- if (Tk_CanvasPsColor(interp, canvas, polyPtr->outlineColor)
- != TCL_OK) {
+ 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;
}
- Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
}
return TCL_OK;
}
+
+
diff --git a/tk/generic/tkCanvPs.c b/tk/generic/tkCanvPs.c
index eb45f87b80b..66b1cc9d7df 100644
--- a/tk/generic/tkCanvPs.c
+++ b/tk/generic/tkCanvPs.c
@@ -6,7 +6,7 @@
* procedures used for generating Postscript.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -68,6 +68,8 @@ typedef struct TkPostscriptInfo {
* 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;
/*
@@ -99,6 +101,8 @@ static Tk_ConfigSpec configSpecs[] = {
"", 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,
@@ -115,6 +119,7 @@ static Tk_ConfigSpec configSpecs[] = {
* The prolog data. Generated by str2c from prolog.ps
* This was split in small chunks by str2c because
* some C compiler have limitations on the size of static strings.
+ * (str2c is a small tcl script in tcl's tool directory (source release))
*/
static CONST char * CONST prolog[]= {
/* Start of part 1 (2000 characters) */
@@ -460,13 +465,15 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
* to know that argv[1] is
* "postscript". */
{
- TkPostscriptInfo psInfo, *oldInfoPtr;
+ TkPostscriptInfo psInfo;
+ Tk_PostscriptInfo oldInfoPtr;
int result;
Tk_Item *itemPtr;
#define STRING_LENGTH 400
char string[STRING_LENGTH+1], *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
@@ -486,8 +493,8 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*----------------------------------------------------------------
*/
- oldInfoPtr = canvasPtr->psInfoPtr;
- canvasPtr->psInfoPtr = &psInfo;
+ oldInfoPtr = canvasPtr->psInfo;
+ canvasPtr->psInfo = (Tk_PostscriptInfo) &psInfo;
psInfo.x = canvasPtr->xOrigin;
psInfo.y = canvasPtr->yOrigin;
psInfo.width = -1;
@@ -509,8 +516,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
psInfo.channelName = NULL;
psInfo.chan = NULL;
psInfo.prepass = 0;
+ psInfo.prolog = 1;
Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
- result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
+ result = Tk_ConfigureWidget(interp, tkwin,
configSpecs, argc-2, argv+2, (char *) &psInfo,
TK_CONFIG_ARGV_ONLY);
if (result != TCL_OK) {
@@ -518,41 +526,41 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
}
if (psInfo.width == -1) {
- psInfo.width = Tk_Width(canvasPtr->tkwin);
+ psInfo.width = Tk_Width(tkwin);
}
if (psInfo.height == -1) {
- psInfo.height = Tk_Height(canvasPtr->tkwin);
+ psInfo.height = Tk_Height(tkwin);
}
psInfo.x2 = psInfo.x + psInfo.width;
psInfo.y2 = psInfo.y + psInfo.height;
if (psInfo.pageXString != NULL) {
- if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
+ if (GetPostscriptPoints(interp, psInfo.pageXString,
&psInfo.pageX) != TCL_OK) {
goto cleanup;
}
}
if (psInfo.pageYString != NULL) {
- if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
+ if (GetPostscriptPoints(interp, psInfo.pageYString,
&psInfo.pageY) != TCL_OK) {
goto cleanup;
}
}
if (psInfo.pageWidthString != NULL) {
- if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
+ if (GetPostscriptPoints(interp, psInfo.pageWidthString,
&psInfo.scale) != TCL_OK) {
goto cleanup;
}
psInfo.scale /= psInfo.width;
} else if (psInfo.pageHeightString != NULL) {
- if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
+ 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(canvasPtr->tkwin));
- psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(tkwin));
}
switch (psInfo.pageAnchor) {
case TK_ANCHOR_NW:
@@ -600,7 +608,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
} else if (strncmp(psInfo.colorMode, "color", length) == 0) {
psInfo.colorLevel = 2;
} else {
- Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
+ Tcl_AppendResult(interp, "bad color mode \"",
psInfo.colorMode, "\": must be monochrome, ",
"gray, or color", (char *) NULL);
goto cleanup;
@@ -614,7 +622,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*/
if (psInfo.channelName != NULL) {
- Tcl_AppendResult(canvasPtr->interp, "can't specify both -file",
+ Tcl_AppendResult(interp, "can't specify both -file",
" and -channel", (char *) NULL);
result = TCL_ERROR;
goto cleanup;
@@ -625,18 +633,18 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
* the -file specification.
*/
- if (Tcl_IsSafe(canvasPtr->interp)) {
- Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a",
+ 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(canvasPtr->interp, psInfo.fileName, &buffer);
+ p = Tcl_TranslateFileName(interp, psInfo.fileName, &buffer);
if (p == NULL) {
goto cleanup;
}
- psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666);
+ psInfo.chan = Tcl_OpenFileChannel(interp, p, "w", 0666);
Tcl_DStringFree(&buffer);
if (psInfo.chan == NULL) {
goto cleanup;
@@ -651,14 +659,14 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
* is open for writing.
*/
- psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName,
+ 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(canvasPtr->interp, "channel \"",
+ Tcl_AppendResult(interp, "channel \"",
psInfo.channelName, "\" wasn't opened for writing",
(char *) NULL);
result = TCL_ERROR;
@@ -686,9 +694,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
if (itemPtr->typePtr->postscriptProc == NULL) {
continue;
}
- result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
+ result = (*itemPtr->typePtr->postscriptProc)(interp,
(Tk_Canvas) canvasPtr, itemPtr, 1);
- Tcl_ResetResult(canvasPtr->interp);
+ Tcl_ResetResult(interp);
if (result != TCL_OK) {
/*
* An error just occurred. Just skip out of this loop.
@@ -708,22 +716,23 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*--------------------------------------------------------
*/
- Tcl_AppendResult(canvasPtr->interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
+ if (psInfo.prolog) {
+ Tcl_AppendResult(interp, "%!PS-Adobe-3.0 EPSF-3.0\n",
"%%Creator: Tk Canvas Widget\n", (char *) NULL);
-#if !(defined(__WIN32__) || defined(MAC_TCL))
+#ifdef HAVE_PW_GECOS
if (!Tcl_IsSafe(interp)) {
- struct passwd *pwPtr = getpwuid(getuid());
- Tcl_AppendResult(canvasPtr->interp, "%%For: ",
+ struct passwd *pwPtr = getpwuid(getuid()); /* INTL: Native. */
+ Tcl_AppendResult(interp, "%%For: ",
(pwPtr != NULL) ? pwPtr->pw_gecos : "Unknown", "\n",
(char *) NULL);
endpwent();
}
-#endif /* __WIN32__ || MAC_TCL */
- Tcl_AppendResult(canvasPtr->interp, "%%Title: Window ",
- Tk_PathName(canvasPtr->tkwin), "\n", (char *) NULL);
+#endif /* HAVE_PW_GECOS */
+ Tcl_AppendResult(interp, "%%Title: Window ",
+ Tk_PathName(tkwin), "\n", (char *) NULL);
time(&now);
- Tcl_AppendResult(canvasPtr->interp, "%%CreationDate: ",
- ctime(&now), (char *) NULL);
+ 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),
@@ -740,21 +749,21 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
(int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
+ 1.0));
}
- Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
+ Tcl_AppendResult(interp, "%%BoundingBox: ", string,
"\n", (char *) NULL);
- Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n",
+ Tcl_AppendResult(interp, "%%Pages: 1\n",
"%%DocumentData: Clean7Bit\n", (char *) NULL);
- Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
+ 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(canvasPtr->interp, p,
+ Tcl_AppendResult(interp, p,
Tcl_GetHashKey(&psInfo.fontTable, hPtr),
"\n", (char *) NULL);
p = "%%+ font ";
}
- Tcl_AppendResult(canvasPtr->interp, "%%EndComments\n\n", (char *) NULL);
+ Tcl_AppendResult(interp, "%%EndComments\n\n", (char *) NULL);
/*
* Insert the prolog
@@ -764,7 +773,7 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
}
if (psInfo.chan != NULL) {
- Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
Tcl_ResetResult(canvasPtr->interp);
}
@@ -775,14 +784,14 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*/
sprintf(string, "/CL %d def\n", psInfo.colorLevel);
- Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
+ Tcl_AppendResult(interp, "%%BeginSetup\n", string,
(char *) NULL);
for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
+ Tcl_AppendResult(interp, "%%IncludeResource: font ",
Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
}
- Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
+ Tcl_AppendResult(interp, "%%EndSetup\n\n", (char *) NULL);
/*
*-----------------------------------------------------------
@@ -792,26 +801,31 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*-----------------------------------------------------------
*/
- Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
+ Tcl_AppendResult(interp, "%%Page: 1 1\n", "save\n",
(char *) NULL);
sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
- Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ Tcl_AppendResult(interp, string, (char *) NULL);
if (psInfo.rotate) {
- Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
+ Tcl_AppendResult(interp, "90 rotate\n", (char *) NULL);
}
sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
- Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ Tcl_AppendResult(interp, string, (char *) NULL);
sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
- Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ Tcl_AppendResult(interp, string, (char *) NULL);
sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
- psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
- psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y),
- psInfo.x2, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2),
- psInfo.x, Tk_CanvasPsY((Tk_Canvas) canvasPtr, (double) psInfo.y2));
- Tcl_AppendResult(canvasPtr->interp, string,
+ 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, canvasPtr->interp->result, -1);
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
Tcl_ResetResult(canvasPtr->interp);
}
@@ -832,21 +846,24 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
if (itemPtr->typePtr->postscriptProc == NULL) {
continue;
}
- Tcl_AppendResult(canvasPtr->interp, "gsave\n", (char *) NULL);
- result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
+ 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[100];
+ char msg[64 + TCL_INTEGER_SPACE];
sprintf(msg, "\n (generating Postscript for item %d)",
itemPtr->id);
- Tcl_AddErrorInfo(canvasPtr->interp, msg);
+ Tcl_AddErrorInfo(interp, msg);
goto cleanup;
}
- Tcl_AppendResult(canvasPtr->interp, "grestore\n", (char *) NULL);
+ Tcl_AppendResult(interp, "grestore\n", (char *) NULL);
if (psInfo.chan != NULL) {
- Tcl_Write(psInfo.chan, canvasPtr->interp->result, -1);
- Tcl_ResetResult(canvasPtr->interp);
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
+ Tcl_ResetResult(interp);
}
}
@@ -857,10 +874,12 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*---------------------------------------------------------------------
*/
- Tcl_AppendResult(canvasPtr->interp, "restore showpage\n\n",
+ 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, canvasPtr->interp->result, -1);
+ Tcl_Write(psInfo.chan, Tcl_GetStringResult(interp), -1);
Tcl_ResetResult(canvasPtr->interp);
}
@@ -894,20 +913,20 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
ckfree(psInfo.fileName);
}
if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
- Tcl_Close(canvasPtr->interp, psInfo.chan);
+ Tcl_Close(interp, psInfo.chan);
}
if (psInfo.channelName != NULL) {
ckfree(psInfo.channelName);
}
Tcl_DeleteHashTable(&psInfo.fontTable);
- canvasPtr->psInfoPtr = oldInfoPtr;
+ canvasPtr->psInfo = (Tk_PostscriptInfo) oldInfoPtr;
return result;
}
/*
*--------------------------------------------------------------
*
- * Tk_CanvasPsColor --
+ * Tk_PostscriptColor --
*
* This procedure is called by individual canvas items when
* they want to set a color value for output. Given information
@@ -916,9 +935,9 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*
* Results:
* Returns a standard Tcl return value. If an error occurs
- * then an error message will be left in interp->result.
+ * then an error message will be left in the interp's result.
* If no error occurs, then additional Postscript will be
- * appended to interp->result.
+ * appended to the interp's result.
*
* Side effects:
* None.
@@ -927,14 +946,12 @@ TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
*/
int
-Tk_CanvasPsColor(interp, canvas, colorPtr)
- Tcl_Interp *interp; /* Interpreter for returning Postscript
- * or error message. */
- Tk_Canvas canvas; /* Information about canvas. */
+Tk_PostscriptColor(interp, psInfo, colorPtr)
+ Tcl_Interp *interp;
+ Tk_PostscriptInfo psInfo; /* Postscript info. */
XColor *colorPtr; /* Information about color. */
{
- TkCanvas *canvasPtr = (TkCanvas *) canvas;
- TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
int tmp;
double red, green, blue;
char string[200];
@@ -988,7 +1005,7 @@ Tk_CanvasPsColor(interp, canvas, colorPtr)
/*
*--------------------------------------------------------------
*
- * Tk_CanvasPsFont --
+ * Tk_PostscriptFont --
*
* This procedure is called by individual canvas items when
* they want to output text. Given information about an X
@@ -997,9 +1014,9 @@ Tk_CanvasPsColor(interp, canvas, colorPtr)
*
* Results:
* Returns a standard Tcl return value. If an error occurs
- * then an error message will be left in interp->result.
+ * 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->result.
+ * appended to the interp's result.
*
* Side effects:
* The Postscript font name is entered into psInfoPtr->fontTable
@@ -1009,17 +1026,15 @@ Tk_CanvasPsColor(interp, canvas, colorPtr)
*/
int
-Tk_CanvasPsFont(interp, canvas, tkfont)
- Tcl_Interp *interp; /* Interpreter for returning Postscript
- * or error message. */
- Tk_Canvas canvas; /* Information about canvas. */
+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. */
{
- TkCanvas *canvasPtr = (TkCanvas *) canvas;
- TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
char *end;
- char pointString[20];
+ char pointString[TCL_INTEGER_SPACE];
Tcl_DString ds;
int i, points;
@@ -1082,7 +1097,7 @@ Tk_CanvasPsFont(interp, canvas, tkfont)
/*
*--------------------------------------------------------------
*
- * Tk_CanvasPsBitmap --
+ * Tk_PostscriptBitmap --
*
* This procedure is called to output the contents of a
* sub-region of a bitmap in proper image data format for
@@ -1091,9 +1106,9 @@ Tk_CanvasPsFont(interp, canvas, tkfont)
*
* Results:
* Returns a standard Tcl return value. If an error occurs
- * then an error message will be left in interp->result.
+ * then an error message will be left in the interp's result.
* If no error occurs, then additional Postscript will be
- * appended to interp->result.
+ * appended to the interp's result.
*
* Side effects:
* None.
@@ -1102,18 +1117,18 @@ Tk_CanvasPsFont(interp, canvas, tkfont)
*/
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. */
+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. */
{
- TkCanvas *canvasPtr = (TkCanvas *) canvas;
- TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
XImage *imagePtr;
int charsInLine, x, y, lastX, lastY, value, mask;
unsigned int totalWidth, totalHeight;
@@ -1134,10 +1149,10 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
* it shouldn't matter here.
*/
- XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
+ XGetGeometry(Tk_Display(tkwin), bitmap, &dummyRoot,
(int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
(unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
- imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
+ imagePtr = XGetImage(Tk_Display(tkwin), bitmap, 0, 0,
totalWidth, totalHeight, 1, XYPixmap);
Tcl_AppendResult(interp, "<", (char *) NULL);
mask = 0x80;
@@ -1179,7 +1194,7 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
/*
*--------------------------------------------------------------
*
- * Tk_CanvasPsStipple --
+ * Tk_PostscriptStipple --
*
* This procedure is called by individual canvas items when
* they have created a path that they'd like to be filled with
@@ -1190,9 +1205,9 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
*
* Results:
* Returns a standard Tcl return value. If an error occurs
- * then an error message will be left in interp->result.
+ * then an error message will be left in the interp's result.
* If no error occurs, then additional Postscript will be
- * appended to interp->result.
+ * appended to the interp's result.
*
* Side effects:
* None.
@@ -1201,16 +1216,16 @@ Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
*/
int
-Tk_CanvasPsStipple(interp, canvas, bitmap)
- Tcl_Interp *interp; /* Interpreter for returning Postscript
+Tk_PostscriptStipple(interp, tkwin, psInfo, bitmap)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* Interpreter for returning Postscript
* or error message. */
- Tk_Canvas canvas; /* Information about canvas. */
Pixmap bitmap; /* Bitmap to use for stippling. */
{
- TkCanvas *canvasPtr = (TkCanvas *) canvas;
- TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
int width, height;
- char string[100];
+ char string[TCL_INTEGER_SPACE * 2];
Window dummyRoot;
int dummyX, dummyY;
unsigned dummyBorderwidth, dummyDepth;
@@ -1227,12 +1242,12 @@ Tk_CanvasPsStipple(interp, canvas, bitmap)
* it shouldn't matter here.
*/
- XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
+ 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_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
+ if (Tk_PostscriptBitmap(interp, tkwin, psInfo, bitmap, 0, 0,
width, height) != TCL_OK) {
return TCL_ERROR;
}
@@ -1243,9 +1258,9 @@ Tk_CanvasPsStipple(interp, canvas, bitmap)
/*
*--------------------------------------------------------------
*
- * Tk_CanvasPsY --
+ * Tk_PostscriptY --
*
- * Given a y-coordinate in canvas coordinates, this procedure
+ * Given a y-coordinate in local coordinates, this procedure
* returns a y-coordinate to use for Postscript output.
*
* Results:
@@ -1259,12 +1274,11 @@ Tk_CanvasPsStipple(interp, canvas, bitmap)
*/
double
-Tk_CanvasPsY(canvas, y)
- Tk_Canvas canvas; /* Token for canvas on whose behalf
- * Postscript is being generated. */
+Tk_PostscriptY(y, psInfo)
double y; /* Y-coordinate in canvas coords. */
+ Tk_PostscriptInfo psInfo; /* Postscript info */
{
- TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
return psInfoPtr->y2 - y;
}
@@ -1272,13 +1286,13 @@ Tk_CanvasPsY(canvas, y)
/*
*--------------------------------------------------------------
*
- * Tk_CanvasPsPath --
+ * 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 interp->result.
+ * Postscript commands get appended to what's in the interp's result.
*
* Side effects:
* None.
@@ -1287,29 +1301,28 @@ Tk_CanvasPsY(canvas, y)
*/
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
+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 = ((TkCanvas *) canvas)->psInfoPtr;
+ TkPostscriptInfo *psInfoPtr = (TkPostscriptInfo *) psInfo;
char buffer[200];
if (psInfoPtr->prepass) {
return;
}
sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
- Tk_CanvasPsY(canvas, coordPtr[1]));
+ 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_CanvasPsY(canvas, coordPtr[1]));
+ Tk_PostscriptY(coordPtr[1], psInfo));
Tcl_AppendResult(interp, buffer, (char *) NULL);
}
}
@@ -1327,7 +1340,7 @@ Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
* TCL_OK is returned, then everything went well and the
* screen distance is stored at *doublePtr; otherwise
* TCL_ERROR is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -1384,3 +1397,750 @@ GetPostscriptPoints(interp, string, doublePtr)
*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/tk/generic/tkCanvText.c b/tk/generic/tkCanvText.c
index fc1dc4c0190..688d86b6b05 100644
--- a/tk/generic/tkCanvText.c
+++ b/tk/generic/tkCanvText.c
@@ -4,7 +4,7 @@
* This file implements text items for canvas widgets.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -36,18 +36,23 @@ typedef struct TextItem {
*/
double x, y; /* Positioning point for text. */
- int insertPos; /* Insertion cursor is displayed just to left
- * of character with this index. */
+ 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. */
@@ -57,7 +62,8 @@ typedef struct TextItem {
* configuration settings above.
*/
- int numChars; /* Number of non-NULL characters in text. */
+ 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
@@ -77,14 +83,31 @@ typedef struct TextItem {
* Information used for parsing configuration specs:
*/
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+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,
@@ -92,6 +115,12 @@ static Tk_ConfigSpec configSpecs[] = {
{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,
@@ -112,10 +141,10 @@ static void ComputeTextBbox _ANSI_ARGS_((Tk_Canvas canvas,
TextItem *textPtr));
static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int CreateText _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeleteText _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayCanvText _ANSI_ARGS_((Tk_Canvas canvas,
@@ -126,7 +155,7 @@ static int GetSelText _ANSI_ARGS_((Tk_Canvas canvas,
int maxBytes));
static int GetTextIndex _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr,
- char *indexString, int *indexPtr));
+ Tcl_Obj *obj, int *indexPtr));
static void ScaleText _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double originX, double originY,
double scaleX, double scaleY));
@@ -134,7 +163,7 @@ static void SetTextCursor _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, int index));
static int TextCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void TextDeleteChars _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, int first, int last));
static void TextInsert _ANSI_ARGS_((Tk_Canvas canvas,
@@ -154,26 +183,26 @@ static void TranslateText _ANSI_ARGS_((Tk_Canvas canvas,
*/
Tk_ItemType tkTextType = {
- "text", /* name */
- sizeof(TextItem), /* itemSize */
- CreateText, /* createProc */
- configSpecs, /* configSpecs */
- ConfigureText, /* configureProc */
- TextCoords, /* coordProc */
- DeleteText, /* deleteProc */
- DisplayCanvText, /* displayProc */
- 0, /* alwaysRedraw */
- TextToPoint, /* pointProc */
- TextToArea, /* areaProc */
- TextToPostscript, /* postscriptProc */
- ScaleText, /* scaleProc */
- TranslateText, /* translateProc */
- GetTextIndex, /* indexProc */
- SetTextCursor, /* icursorProc */
- GetSelText, /* selectionProc */
- TextInsert, /* insertProc */
- TextDeleteChars, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ "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 */
};
/*
@@ -187,7 +216,7 @@ Tk_ItemType tkTextType = {
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item then an error message is left in
- * interp->result; in this case itemPtr is left uninitialized
+ * the interp's result; in this case itemPtr is left uninitialized
* so it can be safely freed by the caller.
*
* Side effects:
@@ -198,16 +227,29 @@ Tk_ItemType tkTextType = {
static int
CreateText(interp, canvas, itemPtr, argc, argv)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- Tk_Canvas canvas; /* Canvas to hold new item. */
- Tk_Item *itemPtr; /* Record to hold new item; header
- * has been initialized by caller. */
- int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing rectangle. */
+ 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. */
{
TextItem *textPtr = (TextItem *) itemPtr;
+ int i;
+
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(argv[1], NULL);
+ if ((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
- if (argc < 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);
@@ -215,8 +257,8 @@ CreateText(interp, canvas, itemPtr, argc, argv)
}
/*
- * Carry out initialization that is needed in order to clean
- * up after errors during the the remainder of this procedure.
+ * 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);
@@ -224,14 +266,22 @@ CreateText(interp, canvas, itemPtr, argc, argv)
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;
@@ -243,17 +293,16 @@ CreateText(interp, canvas, itemPtr, argc, argv)
* Process the arguments to fill in the item record.
*/
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1], &textPtr->y)
- != TCL_OK)) {
- return TCL_ERROR;
+ if ((TextCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
}
-
- if (ConfigureText(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
- DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
- return TCL_ERROR;
+ if (ConfigureText(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
+
+ error:
+ DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
}
/*
@@ -266,7 +315,7 @@ CreateText(interp, canvas, itemPtr, argc, argv)
* details on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -276,32 +325,46 @@ CreateText(interp, canvas, itemPtr, argc, argv)
static int
TextCoords(interp, canvas, itemPtr, argc, argv)
- Tcl_Interp *interp; /* Used for error reporting. */
- Tk_Canvas canvas; /* Canvas containing item. */
- Tk_Item *itemPtr; /* Item whose coordinates are to be
- * read or modified. */
- int argc; /* Number of coordinates supplied in
- * argv. */
- char **argv; /* Array of coordinates: x1, y1,
- * x2, y2, ... */
+ 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, ... */
{
TextItem *textPtr = (TextItem *) itemPtr;
- char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
if (argc == 0) {
- Tcl_PrintDouble(interp, textPtr->x, x);
- Tcl_PrintDouble(interp, textPtr->y, y);
- Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
- } else if (argc == 2) {
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
- &textPtr->y) != TCL_OK)) {
+ 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 (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 + TCL_INTEGER_SPACE];
+
+ 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], &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1],
+ &textPtr->y) != TCL_OK)) {
return TCL_ERROR;
}
ComputeTextBbox(canvas, textPtr);
} else {
- sprintf(interp->result,
- "wrong # coordinates: expected 0 or 2, got %d", argc);
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
@@ -317,7 +380,7 @@ TextCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information, such as colors and stipple
@@ -332,7 +395,7 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
TextItem *textPtr = (TextItem *) itemPtr;
@@ -342,10 +405,13 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
Tk_Window tkwin;
Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
XColor *selBgColorPtr;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
- (char *) textPtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) textPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -354,20 +420,59 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
* 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->color != NULL) && (textPtr->tkfont != NULL)) {
- gcValues.foreground = textPtr->color->pixel;
+ if (textPtr->tkfont != NULL) {
gcValues.font = Tk_FontId(textPtr->tkfont);
- mask = GCForeground|GCFont;
- if (textPtr->stipple != None) {
- gcValues.stipple = textPtr->stipple;
+ 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 |= GCForeground|GCStipple|GCFillStyle;
+ mask |= GCStipple|GCFillStyle;
}
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, textPtr->color, NULL);
gcValues.foreground = textInfoPtr->selFgColorPtr->pixel;
- newSelGC = Tk_GetGCColor(tkwin, mask, &gcValues,
- textInfoPtr->selFgColorPtr, NULL);
+ newSelGC = Tk_GetGC(tkwin, mask|GCForeground, &gcValues);
}
if (textPtr->gc != None) {
Tk_FreeGC(Tk_Display(tkwin), textPtr->gc);
@@ -401,17 +506,19 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
* to keep them inside the item.
*/
- textPtr->numChars = strlen(textPtr->text);
+ 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;
+ textInfoPtr->selectLast = textPtr->numChars - 1;
}
if ((textInfoPtr->anchorItemPtr == itemPtr)
&& (textInfoPtr->selectAnchor >= textPtr->numChars)) {
- textInfoPtr->selectAnchor = textPtr->numChars-1;
+ textInfoPtr->selectAnchor = textPtr->numChars - 1;
}
}
}
@@ -442,20 +549,31 @@ ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
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. */
+ 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);
}
@@ -495,18 +613,26 @@ DeleteText(canvas, itemPtr, display)
static void
ComputeTextBbox(canvas, textPtr)
- Tk_Canvas canvas; /* Canvas that contains item. */
- TextItem *textPtr; /* Item whose bbos is to be
- * recomputed. */
+ 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.
@@ -592,22 +718,37 @@ ComputeTextBbox(canvas, textPtr)
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). */
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ Tk_Item *itemPtr; /* Item to be displayed. */
+ Display *display; /* Display on which to draw item. */
+ Drawable drawable; /* Pixmap or window in which to draw item. */
+ int x, y, width, height; /* Describes region of canvas that must be
+ * redisplayed (not used). */
{
TextItem *textPtr;
Tk_CanvasTextInfo *textInfoPtr;
- int selFirst, selLast;
+ 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;
}
@@ -618,30 +759,31 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
* read-only.
*/
- if (textPtr->stipple != None) {
- Tk_CanvasSetStippleOrigin(canvas, textPtr->gc);
+ if (stipple != None) {
+ Tk_CanvasSetOffset(canvas, textPtr->gc, &textPtr->tsoffset);
}
- selFirst = -1;
- selLast = 0; /* lint. */
+ selFirstChar = -1;
+ selLastChar = 0; /* lint. */
+
if (textInfoPtr->selItemPtr == itemPtr) {
- selFirst = textInfoPtr->selectFirst;
- selLast = textInfoPtr->selectLast;
- if (selLast >= textPtr->numChars) {
- selLast = textPtr->numChars - 1;
+ selFirstChar = textInfoPtr->selectFirst;
+ selLastChar = textInfoPtr->selectLast;
+ if (selLastChar > textPtr->numChars) {
+ selLastChar = textPtr->numChars - 1;
}
- if ((selFirst >= 0) && (selFirst <= selLast)) {
+ if ((selFirstChar >= 0) && (selFirstChar <= selLastChar)) {
+ int xFirst, yFirst, hFirst;
+ int xLast, yLast;
+
/*
* Draw a special background under the selection.
*/
- int xFirst, yFirst, hFirst;
- int xLast, yLast, wLast;
-
- Tk_CharBbox(textPtr->textLayout, selFirst,
- &xFirst, &yFirst, NULL, &hFirst);
- Tk_CharBbox(textPtr->textLayout, selLast,
- &xLast, &yLast, &wLast, NULL);
+ Tk_CharBbox(textPtr->textLayout, selFirstChar, &xFirst, &yFirst,
+ NULL, &hFirst);
+ Tk_CharBbox(textPtr->textLayout, selLastChar, &xLast, &yLast,
+ NULL, NULL);
/*
* If the selection spans the end of this line, then display
@@ -654,7 +796,7 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
height = hFirst;
for (y = yFirst ; y <= yLast; y += height) {
if (y == yLast) {
- width = (xLast + wLast) - x;
+ width = xLast - x;
} else {
width = textPtr->rightEdge - textPtr->leftEdge - x;
}
@@ -725,13 +867,13 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
Tk_DrawTextLayout(display, drawable, textPtr->gc, textPtr->textLayout,
drawableX, drawableY, 0, -1);
- if ((selFirst >= 0) && (textPtr->selTextGC != textPtr->gc)) {
+ if ((selFirstChar >= 0) && (textPtr->selTextGC != textPtr->gc)) {
Tk_DrawTextLayout(display, drawable, textPtr->selTextGC,
- textPtr->textLayout, drawableX, drawableY, selFirst,
- selLast + 1);
+ textPtr->textLayout, drawableX, drawableY, selFirstChar,
+ selLastChar + 1);
}
- if (textPtr->stipple != None) {
+ if (stipple != None) {
XSetTSOrigin(display, textPtr->gc, 0, 0);
}
}
@@ -755,36 +897,44 @@ DisplayCanvText(canvas, itemPtr, display, drawable, x, y, width, height)
*/
static void
-TextInsert(canvas, itemPtr, beforeThis, string)
+TextInsert(canvas, itemPtr, index, string)
Tk_Canvas canvas; /* Canvas containing text item. */
Tk_Item *itemPtr; /* Text item to be modified. */
- int beforeThis; /* Index of character before which text is
+ int index; /* Character index before which string is
* to be inserted. */
char *string; /* New characters to be inserted. */
{
TextItem *textPtr = (TextItem *) itemPtr;
- int length;
- char *new;
+ int byteIndex, byteCount, charsAdded;
+ char *new, *text;
Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
- length = strlen(string);
- if (length == 0) {
- return;
+ string = Tcl_GetStringFromObj((Tcl_Obj *) string, &byteCount);
+
+ text = textPtr->text;
+
+ if (index < 0) {
+ index = 0;
}
- if (beforeThis < 0) {
- beforeThis = 0;
+ if (index > textPtr->numChars) {
+ index = textPtr->numChars;
}
- if (beforeThis > textPtr->numChars) {
- beforeThis = textPtr->numChars;
+ byteIndex = Tcl_UtfAtIndex(text, index) - text;
+ byteCount = strlen(string);
+ if (byteCount == 0) {
+ return;
}
- new = (char *) ckalloc((unsigned) (textPtr->numChars + length + 1));
- strncpy(new, textPtr->text, (size_t) beforeThis);
- strcpy(new+beforeThis, string);
- strcpy(new+beforeThis+length, textPtr->text+beforeThis);
- ckfree(textPtr->text);
+ 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;
- textPtr->numChars += length;
+ charsAdded = Tcl_NumUtfChars(string, byteCount);
+ textPtr->numChars += charsAdded;
+ textPtr->numBytes += byteCount;
/*
* Inserting characters invalidates indices such as those for the
@@ -792,19 +942,19 @@ TextInsert(canvas, itemPtr, beforeThis, string)
*/
if (textInfoPtr->selItemPtr == itemPtr) {
- if (textInfoPtr->selectFirst >= beforeThis) {
- textInfoPtr->selectFirst += length;
+ if (textInfoPtr->selectFirst >= index) {
+ textInfoPtr->selectFirst += charsAdded;
}
- if (textInfoPtr->selectLast >= beforeThis) {
- textInfoPtr->selectLast += length;
+ if (textInfoPtr->selectLast >= index) {
+ textInfoPtr->selectLast += charsAdded;
}
if ((textInfoPtr->anchorItemPtr == itemPtr)
- && (textInfoPtr->selectAnchor >= beforeThis)) {
- textInfoPtr->selectAnchor += length;
+ && (textInfoPtr->selectAnchor >= index)) {
+ textInfoPtr->selectAnchor += charsAdded;
}
}
- if (textPtr->insertPos >= beforeThis) {
- textPtr->insertPos += length;
+ if (textPtr->insertPos >= index) {
+ textPtr->insertPos += charsAdded;
}
ComputeTextBbox(canvas, textPtr);
}
@@ -831,31 +981,40 @@ static void
TextDeleteChars(canvas, itemPtr, first, last)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Item in which to delete characters. */
- int first; /* Index of first character to delete. */
- int last; /* Index of last character to delete. */
+ int first; /* Character index of first character to
+ * delete. */
+ int last; /* Character index of last character to
+ * delete (inclusive). */
{
TextItem *textPtr = (TextItem *) itemPtr;
- int count;
- char *new;
+ 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;
+ last = textPtr->numChars - 1;
}
if (first > last) {
return;
}
- count = last + 1 - first;
+ charsRemoved = last + 1 - first;
- new = (char *) ckalloc((unsigned) (textPtr->numChars + 1 - count));
- strncpy(new, textPtr->text, (size_t) first);
- strcpy(new+first, textPtr->text+last+1);
- ckfree(textPtr->text);
+ 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 -= count;
+ textPtr->numChars -= charsRemoved;
+ textPtr->numBytes -= byteCount;
/*
* Update indexes for the selection and cursor to reflect the
@@ -864,15 +1023,15 @@ TextDeleteChars(canvas, itemPtr, first, last)
if (textInfoPtr->selItemPtr == itemPtr) {
if (textInfoPtr->selectFirst > first) {
- textInfoPtr->selectFirst -= count;
+ textInfoPtr->selectFirst -= charsRemoved;
if (textInfoPtr->selectFirst < first) {
textInfoPtr->selectFirst = first;
}
}
if (textInfoPtr->selectLast >= first) {
- textInfoPtr->selectLast -= count;
- if (textInfoPtr->selectLast < (first-1)) {
- textInfoPtr->selectLast = (first-1);
+ textInfoPtr->selectLast -= charsRemoved;
+ if (textInfoPtr->selectLast < first - 1) {
+ textInfoPtr->selectLast = first - 1;
}
}
if (textInfoPtr->selectFirst > textInfoPtr->selectLast) {
@@ -880,14 +1039,14 @@ TextDeleteChars(canvas, itemPtr, first, last)
}
if ((textInfoPtr->anchorItemPtr == itemPtr)
&& (textInfoPtr->selectAnchor > first)) {
- textInfoPtr->selectAnchor -= count;
+ textInfoPtr->selectAnchor -= charsRemoved;
if (textInfoPtr->selectAnchor < first) {
textInfoPtr->selectAnchor = first;
}
}
}
if (textPtr->insertPos > first) {
- textPtr->insertPos -= count;
+ textPtr->insertPos -= charsRemoved;
if (textPtr->insertPos < first) {
textPtr->insertPos = first;
}
@@ -923,11 +1082,22 @@ TextToPoint(canvas, itemPtr, pointPtr)
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;
- return (double) Tk_DistanceToTextLayout(textPtr->textLayout,
+ 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;
}
/*
@@ -959,6 +1129,11 @@ TextToArea(canvas, itemPtr, rectPtr)
* 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,
@@ -988,11 +1163,11 @@ TextToArea(canvas, itemPtr, rectPtr)
/* 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. */
+ 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;
@@ -1023,10 +1198,9 @@ ScaleText(canvas, itemPtr, originX, originY, scaleX, scaleY)
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. */
+ 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;
@@ -1047,7 +1221,7 @@ TranslateText(canvas, itemPtr, deltaX, deltaY)
* 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.
+ * the interp's result.
*
* Side effects:
* None.
@@ -1056,20 +1230,22 @@ TranslateText(canvas, itemPtr, deltaX, deltaY)
*/
static int
-GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
+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. */
- char *string; /* Specification of a particular character
+ Tcl_Obj *obj; /* Specification of a particular character
* in itemPtr's text. */
- int *indexPtr; /* Where to store converted index. */
+ 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);
@@ -1081,14 +1257,14 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
} else if ((c == 's') && (strncmp(string, "sel.first", length) == 0)
&& (length >= 5)) {
if (textInfoPtr->selItemPtr != itemPtr) {
- interp->result = "selection isn't in item";
+ 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) {
- interp->result = "selection isn't in item";
+ Tcl_SetResult(interp, "selection isn't in item", TCL_STATIC);
return TCL_ERROR;
}
*indexPtr = textInfoPtr->selectLast;
@@ -1112,7 +1288,7 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
*indexPtr = Tk_PointToChar(textPtr->textLayout,
x + canvasPtr->scrollX1 - textPtr->leftEdge,
y + canvasPtr->scrollY1 - textPtr->header.y1);
- } else if (Tcl_GetInt(interp, string, indexPtr) == TCL_OK) {
+ } else if (Tcl_GetIntFromObj((Tcl_Interp *)NULL, obj, indexPtr) == TCL_OK) {
if (*indexPtr < 0){
*indexPtr = 0;
} else if (*indexPtr > textPtr->numChars) {
@@ -1120,7 +1296,7 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
}
} else {
/*
- * Some of the paths here leave messages in interp->result,
+ * Some of the paths here leave messages in the interp's result,
* so we have to clear it out before storing our own message.
*/
@@ -1152,11 +1328,11 @@ GetTextIndex(interp, canvas, itemPtr, string, indexPtr)
/* ARGSUSED */
static void
SetTextCursor(canvas, itemPtr, index)
- Tk_Canvas canvas; /* Record describing canvas widget. */
- Tk_Item *itemPtr; /* Text item in which cursor position
- * is to be set. */
- int index; /* Index of character just before which
- * cursor is to be positioned. */
+ 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;
@@ -1192,34 +1368,38 @@ SetTextCursor(canvas, itemPtr, index)
static int
GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
- Tk_Canvas canvas; /* Canvas containing selection. */
- Tk_Item *itemPtr; /* Text item containing selection. */
- int offset; /* Offset within selection of first
- * character to be returned. */
- char *buffer; /* Location in which to place
- * selection. */
- int maxBytes; /* Maximum number of bytes to place
- * at buffer, not including terminating
- * NULL character. */
+ 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 count;
+ int byteCount;
+ char *text, *selStart, *selEnd;
Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
- count = textInfoPtr->selectLast + 1 - textInfoPtr->selectFirst - offset;
- if (textInfoPtr->selectLast == textPtr->numChars) {
- count -= 1;
+ if ((textInfoPtr->selectFirst < 0) ||
+ (textInfoPtr->selectFirst > textInfoPtr->selectLast)) {
+ return 0;
}
- if (count > maxBytes) {
- count = maxBytes;
+ 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 (count <= 0) {
+ if (byteCount <= 0) {
return 0;
}
- strncpy(buffer, textPtr->text + textInfoPtr->selectFirst + offset,
- (size_t) count);
- buffer[count] = '\0';
- return count;
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
}
/*
@@ -1233,7 +1413,7 @@ GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
* 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
+ * 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.
*
@@ -1245,23 +1425,44 @@ GetSelText(canvas, itemPtr, offset, buffer, maxBytes)
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. */
+ 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 (textPtr->color == NULL) {
+ 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) {
@@ -1270,13 +1471,13 @@ TextToPostscript(interp, canvas, itemPtr, prepass)
if (prepass != 0) {
return TCL_OK;
}
- if (Tk_CanvasPsColor(interp, canvas, textPtr->color) != TCL_OK) {
+ if (Tk_CanvasPsColor(interp, canvas, color) != TCL_OK) {
return TCL_ERROR;
}
- if (textPtr->stipple != None) {
+ if (stipple != None) {
Tcl_AppendResult(interp, "/StippleText {\n ",
(char *) NULL);
- Tk_CanvasPsStipple(interp, canvas, textPtr->stipple);
+ Tk_CanvasPsStipple(interp, canvas, stipple);
Tcl_AppendResult(interp, "} bind def\n", (char *) NULL);
}
@@ -1307,8 +1508,9 @@ TextToPostscript(interp, canvas, itemPtr, prepass)
Tk_GetFontMetrics(textPtr->tkfont, &fm);
sprintf(buffer, "] %d %g %g %s %s DrawText\n",
fm.linespace, x / -2.0, y / 2.0, justify,
- ((textPtr->stipple == None) ? "false" : "true"));
+ ((stipple == None) ? "false" : "true"));
Tcl_AppendResult(interp, buffer, (char *) NULL);
return TCL_OK;
}
+
diff --git a/tk/generic/tkCanvUtil.c b/tk/generic/tkCanvUtil.c
index a78ae194ec0..0abf9665574 100644
--- a/tk/generic/tkCanvUtil.c
+++ b/tk/generic/tkCanvUtil.c
@@ -13,7 +13,7 @@
* RCS: @(#) $Id$
*/
-#include "tk.h"
+#include "tkInt.h"
#include "tkCanvas.h"
#include "tkPort.h"
@@ -177,7 +177,7 @@ Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr)
* 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.
+ * the interp's result.
*
* Side effects:
* None.
@@ -201,6 +201,44 @@ Tk_CanvasGetCoord(interp, canvas, string, doublePtr)
*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;
+}
/*
*----------------------------------------------------------------------
@@ -237,6 +275,50 @@ Tk_CanvasSetStippleOrigin(canvas, gc)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -374,3 +456,1020 @@ Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
*freeProcPtr = TCL_DYNAMIC;
return Tcl_Merge(itemPtr->numTags, (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;
+ }
+
+ 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;
+ 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/tk/generic/tkCanvWind.c b/tk/generic/tkCanvWind.c
index 1aa81620210..8a452b70d39 100644
--- a/tk/generic/tkCanvWind.c
+++ b/tk/generic/tkCanvWind.c
@@ -41,7 +41,12 @@ typedef struct WindowItem {
* Information used for parsing configuration specs:
*/
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+static Tk_CustomOption stateOption = {
+ (Tk_OptionParseProc *) TkStateParseProc,
+ TkStatePrintProc, (ClientData) 2
+};
+static Tk_CustomOption tagsOption = {
+ (Tk_OptionParseProc *) Tk_CanvasTagsParseProc,
Tk_CanvasTagsPrintProc, (ClientData) NULL
};
@@ -50,6 +55,9 @@ static Tk_ConfigSpec configSpecs[] = {
"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,
@@ -68,10 +76,10 @@ static void ComputeWindowBbox _ANSI_ARGS_((Tk_Canvas canvas,
WindowItem *winItemPtr));
static int ConfigureWinItem _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeleteWinItem _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayWinItem _ANSI_ARGS_((Tk_Canvas canvas,
@@ -84,7 +92,7 @@ static void TranslateWinItem _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double deltaX, double deltaY));
static int WinItemCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv));
+ Tcl_Obj *CONST argv[]));
static void WinItemLostSlaveProc _ANSI_ARGS_((
ClientData clientData, Tk_Window tkwin));
static void WinItemRequestProc _ANSI_ARGS_((ClientData clientData,
@@ -93,8 +101,17 @@ 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
@@ -110,10 +127,10 @@ Tk_ItemType tkWindowType = {
WinItemCoords, /* coordProc */
DeleteWinItem, /* deleteProc */
DisplayWinItem, /* displayProc */
- 1, /* alwaysRedraw */
+ 1|TK_CONFIG_OBJS, /* flags */
WinItemToPoint, /* pointProc */
WinItemToArea, /* areaProc */
- (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */
+ WinItemToPostscript, /* postscriptProc */
ScaleWinItem, /* scaleProc */
TranslateWinItem, /* translateProc */
(Tk_ItemIndexProc *) NULL, /* indexProc */
@@ -121,7 +138,7 @@ Tk_ItemType tkWindowType = {
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
(Tk_ItemInsertProc *) NULL, /* insertProc */
(Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
@@ -147,7 +164,7 @@ static Tk_GeomMgr canvasGeomType = {
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is
+ * the interp's result; in this case itemPtr is
* left uninitialized, so it can be safely freed by the
* caller.
*
@@ -164,11 +181,24 @@ CreateWinItem(interp, canvas, itemPtr, argc, argv)
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing rectangle. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing window. */
{
WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int i;
+
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(argv[1], NULL);
+ if (((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z'))) {
+ i = 1;
+ } else {
+ i = 2;
+ }
+ }
- if (argc < 2) {
+ if (argc < i) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
itemPtr->typePtr->name, " x y ?options?\"",
@@ -190,18 +220,16 @@ CreateWinItem(interp, canvas, itemPtr, argc, argv)
* Process the arguments to fill in the item record.
*/
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
- &winItemPtr->y) != TCL_OK)) {
- return TCL_ERROR;
+ if ((WinItemCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
}
-
- if (ConfigureWinItem(interp, canvas, itemPtr, argc-2, argv+2, 0)
- != TCL_OK) {
- DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
- return TCL_ERROR;
+ if (ConfigureWinItem(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
+
+ error:
+ DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
}
/*
@@ -214,7 +242,7 @@ CreateWinItem(interp, canvas, itemPtr, argc, argv)
* details on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -230,26 +258,42 @@ WinItemCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
WindowItem *winItemPtr = (WindowItem *) itemPtr;
- char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
if (argc == 0) {
- Tcl_PrintDouble(interp, winItemPtr->x, x);
- Tcl_PrintDouble(interp, winItemPtr->y, y);
- Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
- } else if (argc == 2) {
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x)
- != TCL_OK) || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ 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 (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 + TCL_INTEGER_SPACE];
+
+ 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], &winItemPtr->x)
+ != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1],
&winItemPtr->y) != TCL_OK)) {
return TCL_ERROR;
}
ComputeWindowBbox(canvas, winItemPtr);
} else {
- sprintf(interp->result,
- "wrong # coordinates: expected 0 or 2, got %d", argc);
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
@@ -265,7 +309,7 @@ WinItemCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information may be set for itemPtr.
@@ -279,7 +323,7 @@ ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Window item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
WindowItem *winItemPtr = (WindowItem *) itemPtr;
@@ -288,8 +332,8 @@ ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags)
oldWindow = winItemPtr->tkwin;
canvasTkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, argc, argv,
- (char *) winItemPtr, flags) != TCL_OK) {
+ if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, argc, (char **) argv,
+ (char *) winItemPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -415,11 +459,15 @@ ComputeWindowBbox(canvas, winItemPtr)
* 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 (winItemPtr->tkwin == NULL) {
+ 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
@@ -540,11 +588,18 @@ DisplayWinItem(canvas, itemPtr, display, drawable, regionX, regionY,
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;
@@ -591,7 +646,7 @@ DisplayWinItem(canvas, itemPtr, display, drawable, regionX, regionY,
* WinItemToPoint --
*
* Computes the distance from a given point to a given
- * rectangle, in canvas units.
+ * window, in canvas units.
*
* Results:
* The return value is 0 if the point whose x and y coordinates
@@ -620,7 +675,7 @@ WinItemToPoint(canvas, itemPtr, pointPtr)
y2 = winItemPtr->header.y2;
/*
- * Point is outside rectangle.
+ * Point is outside window.
*/
if (pointPtr[0] < x1) {
@@ -690,16 +745,203 @@ WinItemToArea(canvas, itemPtr, rectPtr)
/*
*--------------------------------------------------------------
*
+ * 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 rectangle or oval
- * item.
+ * This procedure is invoked to rescale a window item.
*
* Results:
* None.
*
* Side effects:
- * The rectangle or oval referred to by itemPtr is rescaled
+ * The window referred to by itemPtr is rescaled
* so that the following transformation is applied to all
* point coordinates:
* x' = originX + scaleX*(x-originX)
@@ -710,9 +952,9 @@ WinItemToArea(canvas, itemPtr, rectPtr)
static void
ScaleWinItem(canvas, itemPtr, originX, originY, scaleX, scaleY)
- Tk_Canvas canvas; /* Canvas containing rectangle. */
- Tk_Item *itemPtr; /* Rectangle to be scaled. */
- double originX, originY; /* Origin about which to scale rect. */
+ 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. */
{
@@ -734,16 +976,15 @@ ScaleWinItem(canvas, itemPtr, originX, originY, scaleX, scaleY)
*
* TranslateWinItem --
*
- * This procedure is called to move a rectangle or oval by a
- * given amount.
+ * This procedure is called to move a window 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.
+ * The position of the window is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
*
*--------------------------------------------------------------
*/
@@ -860,3 +1101,4 @@ WinItemLostSlaveProc(clientData, tkwin)
Tk_UnmapWindow(winItemPtr->tkwin);
winItemPtr->tkwin = NULL;
}
+
diff --git a/tk/generic/tkCanvas.c b/tk/generic/tkCanvas.c
index 9455014c030..aea03485631 100644
--- a/tk/generic/tkCanvas.c
+++ b/tk/generic/tkCanvas.c
@@ -6,8 +6,8 @@
* objects such as rectangles, lines, and texts.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * 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.
@@ -15,6 +15,8 @@
* RCS: @(#) $Id$
*/
+/* #define USE_OLD_TAG_SEARCH 1 */
+
#include "default.h"
#include "tkInt.h"
#include "tkPort.h"
@@ -24,6 +26,7 @@
* 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
@@ -43,6 +46,65 @@ typedef struct TagSearch {
* 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.
*/
@@ -90,6 +152,9 @@ static Tk_ConfigSpec configSpecs[] = {
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",
@@ -113,6 +178,9 @@ static Tk_ConfigSpec configSpecs[] = {
{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},
@@ -143,27 +211,30 @@ static Tk_ConfigSpec configSpecs[] = {
static Tk_ItemType *typeList = NULL; /* NULL means initialization hasn't
* been done yet. */
+#ifndef USE_OLD_TAG_SEARCH
/*
- * Standard item types provided by Tk:
+ * Uids for operands in compiled advanced tag search expressions
+ * Initialization is done by InitCanvas()
*/
-
-extern Tk_ItemType tkArcType, tkBitmapType, tkImageType, tkLineType;
-extern Tk_ItemType tkOvalType, tkPolygonType;
-extern Tk_ItemType tkRectangleType, tkTextType, tkWindowType;
-
-/*
- * Various Tk_Uid's used by this module (set up during initialization):
- */
-
static Tk_Uid allUid = NULL;
static Tk_Uid currentUid = NULL;
+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 */
/*
- * Statistics counters:
+ * Standard item types provided by Tk:
*/
-static int numIdSearches;
-static int numSlowSearches;
+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:
@@ -194,34 +265,65 @@ static void CanvasSetOrigin _ANSI_ARGS_((TkCanvas *canvasPtr,
static void CanvasUpdateScrollbars _ANSI_ARGS_((
TkCanvas *canvasPtr));
static int CanvasWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ 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, char **argv,
+ 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, char **argv,
- char *newTag, char *cmdName, char *option));
+ 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, char **argv, Tk_Uid uid,
+ TkCanvas *canvasPtr, Tcl_Obj *CONST *argv, Tk_Uid uid,
int enclosed));
static double GridAlign _ANSI_ARGS_((double coord, double spacing));
+static 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 void PrintScrollFractions _ANSI_ARGS_((int screen1,
int screen2, int object1, int object2,
char *string));
+#ifdef USE_OLD_TAG_SEARCH
static void RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
- char *tag, Tk_Item *prevPtr));
+ Tcl_Obj *tag, Tk_Item *prevPtr));
static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
- char *tag, TagSearch *searchPtr));
+ 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
@@ -238,7 +340,7 @@ static TkClassProcs canvasClass = {
/*
*--------------------------------------------------------------
*
- * Tk_CanvasCmd --
+ * Tk_CanvasObjCmd --
*
* This procedure is invoked to process the "canvas" Tcl
* command. See the user documentation for details on what
@@ -254,12 +356,12 @@ static TkClassProcs canvasClass = {
*/
int
-Tk_CanvasCmd(clientData, interp, argc, argv)
+Tk_CanvasObjCmd(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. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
{
Tk_Window tkwin = (Tk_Window) clientData;
TkCanvas *canvasPtr;
@@ -270,12 +372,12 @@ Tk_CanvasCmd(clientData, interp, argc, argv)
}
if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 1, argv, "pathName ?options?");
return TCL_ERROR;
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ new = Tk_CreateWindowFromPath(interp, tkwin,
+ Tcl_GetString(argv[1]), (char *) NULL);
if (new == NULL) {
return TCL_ERROR;
}
@@ -290,7 +392,7 @@ Tk_CanvasCmd(clientData, interp, argc, argv)
canvasPtr->tkwin = new;
canvasPtr->display = Tk_Display(new);
canvasPtr->interp = interp;
- canvasPtr->widgetCmd = Tcl_CreateCommand(interp,
+ canvasPtr->widgetCmd = Tcl_CreateObjCommand(interp,
Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd,
(ClientData) canvasPtr, CanvasCmdDeletedProc);
canvasPtr->firstItemPtr = NULL;
@@ -354,9 +456,16 @@ Tk_CanvasCmd(clientData, interp, argc, argv)
canvasPtr->pixelsPerMM /= WidthMMOfScreen(Tk_Screen(new));
canvasPtr->flags = 0;
canvasPtr->nextId = 1;
- canvasPtr->psInfoPtr = NULL;
+ 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");
TkSetClassProcs(canvasPtr->tkwin, &canvasClass, (ClientData) canvasPtr);
Tk_CreateEventHandler(canvasPtr->tkwin,
@@ -372,7 +481,7 @@ Tk_CanvasCmd(clientData, interp, argc, argv)
goto error;
}
- interp->result = Tk_PathName(canvasPtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(canvasPtr->tkwin), TCL_STATIC);
return TCL_OK;
error:
@@ -404,50 +513,93 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
* widget. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ Tcl_Obj *CONST argv[]; /* Argument objects. */
{
TkCanvas *canvasPtr = (TkCanvas *) clientData;
- size_t length;
+ 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 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ 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;
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "addtag", length) == 0)) {
+ switch ((enum options) index) {
+ case CANV_ADDTAG: {
if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " addtags tag searchCommand ?arg arg ...?\"",
- (char *) NULL);
- goto error;
- }
- result = FindItems(interp, canvasPtr, argc-3, argv+3, argv[2], argv[0],
- " addtag tag");
- } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)
- && (length >= 2)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " bbox tagOrId ?tagOrId ...?\"",
- (char *) NULL);
- goto error;
+ 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;
@@ -475,17 +627,20 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
}
if (gotAny) {
- sprintf(interp->result, "%d %d %d %d", x1, y1, x2, y2);
- }
- } else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0)
- && (length >= 2)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " bind tagOrId ?sequence? ?command?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?sequence? ?command?");
+ result = TCL_ERROR;
+ goto done;
}
/*
@@ -494,12 +649,13 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
*/
object = 0;
- if (isdigit(UCHAR(argv[2][0]))) {
+#ifdef USE_OLD_TAG_SEARCH
+ if (isdigit(UCHAR(Tcl_GetString(argv[2])[0]))) {
int id;
char *end;
Tcl_HashEntry *entryPtr;
- id = strtoul(argv[2], &end, 0);
+ id = strtoul(Tcl_GetString(argv[2]), &end, 0);
if (*end != 0) {
goto bindByTag;
}
@@ -510,14 +666,38 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
if (object == 0) {
- Tcl_AppendResult(interp, "item \"", argv[2],
+ Tcl_AppendResult(interp, "item \"", Tcl_GetString(argv[2]),
"\" doesn't exist", (char *) NULL);
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
} else {
bindByTag:
- object = (ClientData) Tk_GetUid(argv[2]);
+ 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
@@ -531,20 +711,51 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
if (argc == 5) {
int append = 0;
unsigned long mask;
+ char* argv4 = Tcl_GetStringFromObj(argv[4],NULL);
- if (argv[4][0] == 0) {
+ if (argv4[0] == 0) {
result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
- object, argv[3]);
+ object, Tcl_GetStringFromObj(argv[3], NULL));
goto done;
}
- if (argv[4][0] == '+') {
- argv[4]++;
+#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, argv[3], argv[4], append);
+ object, Tcl_GetStringFromObj(argv[3],NULL), argv4, append);
if (mask == 0) {
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
|Button2MotionMask|Button3MotionMask|Button4MotionMask
@@ -552,140 +763,183 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
|EnterWindowMask|LeaveWindowMask|KeyPressMask
|KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
Tk_DeleteBinding(interp, canvasPtr->bindingTable,
- object, argv[3]);
+ 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);
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
} else if (argc == 4) {
char *command;
command = Tk_GetBinding(interp, canvasPtr->bindingTable,
- object, argv[3]);
+ object, Tcl_GetStringFromObj(argv[3], NULL));
if (command == NULL) {
- goto error;
+ 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, command, TCL_STATIC);
}
- interp->result = command;
} else {
Tk_GetAllBindings(interp, canvasPtr->bindingTable, object);
}
- } else if ((c == 'c') && (strcmp(argv[1], "canvasx") == 0)) {
+ break;
+ }
+ case CANV_CANVASX: {
int x;
double grid;
+ char buf[TCL_DOUBLE_SPACE];
if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " canvasx screenx ?gridspacing?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "screenx ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
}
- if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
- goto error;
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &x) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
}
if (argc == 4) {
- if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
&grid) != TCL_OK) {
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
} else {
grid = 0.0;
}
x += canvasPtr->xOrigin;
- Tcl_PrintDouble(interp, GridAlign((double) x, grid), interp->result);
- } else if ((c == 'c') && (strcmp(argv[1], "canvasy") == 0)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " canvasy screeny ?gridspacing?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "screeny ?gridspacing?");
+ result = TCL_ERROR;
+ goto done;
}
- if (Tk_GetPixels(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
- goto error;
+ if (Tk_GetPixelsFromObj(interp, canvasPtr->tkwin, argv[2], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
}
if (argc == 4) {
- if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ if (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
argv[3], &grid) != TCL_OK) {
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
} else {
grid = 0.0;
}
y += canvasPtr->yOrigin;
- Tcl_PrintDouble(interp, GridAlign((double) y, grid), interp->result);
- } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
+ Tcl_PrintDouble(interp, GridAlign((double) y, grid), buf);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ case CANV_CGET: {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "option");
+ result = TCL_ERROR;
+ goto done;
}
result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
- (char *) canvasPtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 3)) {
+ (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, argv[2], 0);
+ (char *) canvasPtr, Tcl_GetString(argv[2]), 0);
} else {
result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
TK_CONFIG_ARGV_ONLY);
}
- } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
- && (length >= 3)) {
+ break;
+ }
+ case CANV_COORDS: {
if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " coords tagOrId ?x y x y ...?\"",
- (char *) NULL);
- goto error;
+ 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) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ 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 {
+ 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) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
}
}
- } else if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)
- && (length >= 2)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " create type ?arg arg ...?\"", (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "type ?arg arg ...?");
+ result = TCL_ERROR;
+ goto done;
}
- c = argv[2][0];
- length = strlen(argv[2]);
+ arg = Tcl_GetStringFromObj(argv[2], (int *) &length);
+ c = arg[0];
for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
if ((c == typePtr->name[0])
- && (strncmp(argv[2], typePtr->name, length) == 0)) {
+ && (strncmp(arg, typePtr->name, length) == 0)) {
if (matchPtr != NULL) {
badType:
Tcl_AppendResult(interp,
"unknown or ambiguous item type \"",
- argv[2], "\"", (char *) NULL);
- goto error;
+ arg, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
matchPtr = typePtr;
}
@@ -701,10 +955,21 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
itemPtr->tagSpace = TK_TAG_SPACE;
itemPtr->numTags = 0;
itemPtr->typePtr = typePtr;
- if ((*typePtr->createProc)(interp, (Tk_Canvas) canvasPtr,
- itemPtr, argc-3, argv+3) != TCL_OK) {
+ 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 {
+ 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);
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
itemPtr->nextPtr = NULL;
entryPtr = Tcl_CreateHashEntry(&canvasPtr->idTable,
@@ -719,35 +984,56 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
canvasPtr->lastItemPtr->nextPtr = itemPtr;
}
canvasPtr->lastItemPtr = itemPtr;
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ itemPtr->redraw_flags |= FORCE_REDRAW;
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
canvasPtr->flags |= REPICK_NEEDED;
- sprintf(interp->result, "%d", itemPtr->id);
- } else if ((c == 'd') && (strncmp(argv[1], "dchars", length) == 0)
- && (length >= 2)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " dchars tagOrId first ?last?\"",
- (char *) NULL);
- goto error;
+ 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->indexProc)(interp, (Tk_Canvas) canvasPtr,
- itemPtr, argv[3], &first) != TCL_OK) {
- goto error;
+ 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->indexProc)(interp,
- (Tk_Canvas) canvasPtr, itemPtr, argv[4], &last)
- != TCL_OK) {
- goto error;
+ 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;
@@ -756,26 +1042,40 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
/*
* 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.
+ * the old area. Except if the insertProc sets the
+ * TK_ITEM_DONT_REDRAW flag, nothing more needs to be done.
*/
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ 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);
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ 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;
}
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
- && (length >= 2)) {
+ 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)) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+#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);
@@ -824,24 +1124,32 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
}
}
- } else if ((c == 'd') && (strncmp(argv[1], "dtag", length) == 0)
- && (length >= 2)) {
+ break;
+ }
+ case CANV_DTAG: {
Tk_Uid tag;
int i;
if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " dtag tagOrId ?tagToDelete?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?tagToDelete?");
+ result = TCL_ERROR;
+ goto done;
}
if (argc == 4) {
- tag = Tk_GetUid(argv[3]);
+ tag = Tk_GetUid(Tcl_GetStringFromObj(argv[3], NULL));
} else {
- tag = Tk_GetUid(argv[2]);
+ 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];
@@ -849,41 +1157,55 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
}
}
- } else if ((c == 'f') && (strncmp(argv[1], "find", length) == 0)
- && (length >= 2)) {
+ break;
+ }
+ case CANV_FIND: {
if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " find searchCommand ?arg arg ...?\"",
- (char *) NULL);
- goto error;
- }
- result = FindItems(interp, canvasPtr, argc-2, argv+2, (char *) NULL,
- argv[0]," find");
- } else if ((c == 'f') && (strncmp(argv[1], "focus", length) == 0)
- && (length >= 2)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " focus ?tagOrId?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "?tagOrId?");
+ result = TCL_ERROR;
+ goto done;
}
itemPtr = canvasPtr->textInfo.focusItemPtr;
if (argc == 2) {
if (itemPtr != NULL) {
- sprintf(interp->result, "%d", itemPtr->id);
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", itemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
goto done;
}
if ((itemPtr != NULL) && (canvasPtr->textInfo.gotFocus)) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
}
- if (argv[2][0] == 0) {
+ 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;
}
@@ -893,134 +1215,214 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
canvasPtr->textInfo.focusItemPtr = itemPtr;
if (canvasPtr->textInfo.gotFocus) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
}
- } else if ((c == 'g') && (strncmp(argv[1], "gettags", length) == 0)) {
+ break;
+ }
+ case CANV_GETTAGS: {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " gettags tagOrId\"", (char *) NULL);
- goto error;
+ 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]);
}
}
- } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0)
- && (length >= 2)) {
+ break;
+ }
+ case CANV_ICURSOR: {
int index;
if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " icursor tagOrId index\"",
- (char *) NULL);
- goto error;
+ 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->indexProc)(interp, (Tk_Canvas) canvasPtr,
- itemPtr, argv[3], &index) != TCL_OK) {
- goto error;
+ 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)) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
}
}
- } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
- && (length >= 3)) {
+ break;
+ }
+ case CANV_INDEX: {
+
int index;
+ char buf[TCL_INTEGER_SPACE];
if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " index tagOrId string\"",
- (char *) NULL);
- goto error;
+ 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 \"",
- argv[2], "\"", (char *) NULL);
- goto error;
+ Tcl_GetStringFromObj(argv[2], NULL), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
- if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
- itemPtr, argv[3], &index) != TCL_OK) {
- goto error;
+ 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);
}
- sprintf(interp->result, "%d", index);
- } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
- && (length >= 3)) {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " insert tagOrId beforeThis string\"",
- (char *) NULL);
- goto error;
+ 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->indexProc)(interp, (Tk_Canvas) canvasPtr,
- itemPtr, argv[3], &beforeThis) != TCL_OK) {
- goto error;
+ 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.
+ * larger or smaller than the old area. Except if the
+ * insertProc sets the TK_ITEM_DONT_REDRAW flag, nothing
+ * more needs to be done.
*/
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
- (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
- itemPtr, beforeThis, argv[4]);
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1,
- itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ 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;
}
- } else if ((c == 'i') && (strncmp(argv[1], "itemcget", length) == 0)
- && (length >= 6)) {
+ break;
+ }
+ case CANV_ITEMCGET: {
if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " itemcget tagOrId option\"",
- (char *) NULL);
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId option");
return TCL_ERROR;
}
+#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,
- argv[3], 0);
+ Tcl_GetStringFromObj(argv[3], NULL), 0);
}
- } else if ((c == 'i') && (strncmp(argv[1], "itemconfigure", length) == 0)
- && (length >= 6)) {
+ break;
+ }
+ case CANV_ITEMCONFIGURE: {
if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " itemconfigure tagOrId ?option value ...?\"",
- (char *) NULL);
- goto error;
+ 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,
@@ -1028,29 +1430,36 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
} else if (argc == 4) {
result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
itemPtr->typePtr->configSpecs, (char *) itemPtr,
- argv[3], 0);
+ Tcl_GetString(argv[3]), 0);
} else {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ 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);
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ } else {
+ 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;
}
}
- } else if ((c == 'l') && (strncmp(argv[1], "lower", length) == 0)) {
+ break;
+ }
+ case CANV_LOWER: {
Tk_Item *itemPtr;
if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " lower tagOrId ?belowThis?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?belowThis?");
+ result = TCL_ERROR;
+ goto done;
}
/*
@@ -1061,49 +1470,75 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
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 \"", argv[3],
+ Tcl_AppendResult(interp, "tag \"", Tcl_GetString(argv[3]),
"\" doesn't match any items", (char *) NULL);
- goto error;
+ goto done;
}
itemPtr = itemPtr->prevPtr;
}
+#ifdef USE_OLD_TAG_SEARCH
RelinkItems(canvasPtr, argv[2], itemPtr);
- } else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) {
+#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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " move tagOrId xAmount yAmount\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xAmount yAmount");
+ result = TCL_ERROR;
+ goto done;
}
- if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
- &xAmount) != TCL_OK) || (Tk_CanvasGetCoord(interp,
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &xAmount) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp,
(Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
+#ifdef USE_OLD_TAG_SEARCH
for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
itemPtr != NULL; itemPtr = NextItem(&search)) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+#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);
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
canvasPtr->flags |= REPICK_NEEDED;
}
- } else if ((c == 'p') && (strncmp(argv[1], "postscript", length) == 0)) {
- result = TkCanvPostscriptCmd(canvasPtr, interp, argc, argv);
- } else if ((c == 'r') && (strncmp(argv[1], "raise", length) == 0)) {
+ break;
+ }
+ case CANV_POSTSCRIPT: {
+ 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " raise tagOrId ?aboveThis?\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId ?aboveThis?");
+ result = TCL_ERROR;
+ goto done;
}
/*
@@ -1115,70 +1550,106 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
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 \"", argv[3],
+ Tcl_AppendResult(interp, "tagOrId \"", Tcl_GetStringFromObj(argv[3], NULL),
"\" doesn't match any items", (char *) NULL);
- goto error;
+ result = TCL_ERROR;
+ goto done;
}
}
+#ifdef USE_OLD_TAG_SEARCH
RelinkItems(canvasPtr, argv[2], prevPtr);
- } else if ((c == 's') && (strncmp(argv[1], "scale", length) == 0)
- && (length >= 3)) {
+#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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " scale tagOrId xOrigin yOrigin xScale yScale\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId xOrigin yOrigin xScale yScale");
+ result = TCL_ERROR;
+ goto done;
}
- if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
argv[3], &xOrigin) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr,
argv[4], &yOrigin) != TCL_OK)
- || (Tcl_GetDouble(interp, argv[5], &xScale) != TCL_OK)
- || (Tcl_GetDouble(interp, argv[6], &yScale) != TCL_OK)) {
- goto error;
+ || (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)) {
- interp->result = "scale factor cannot be zero";
- goto error;
+ 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)) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+#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);
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
canvasPtr->flags |= REPICK_NEEDED;
}
- } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0)
- && (length >= 3)) {
- int x, y;
+ break;
+ }
+ case CANV_SCAN: {
+ int x, y, gain=10;
+ static char *optionStrings[] = {
+ "mark", "dragto", NULL
+ };
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " scan mark|dragto x y\"", (char *) NULL);
- goto error;
+ if (Tcl_GetIndexFromObj(interp, argv[2], optionStrings, "scan option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
}
- if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){
- goto error;
+
+ if ((argc != 5) && (argc != 5+index)) {
+ Tcl_WrongNumArgs(interp, 3, argv, index?"x y ?gain?":"x y");
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((Tcl_GetIntFromObj(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, argv[4], &y) != TCL_OK)){
+ result = TCL_ERROR;
+ goto done;
}
- if ((argv[2][0] == 'm')
- && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ if ((argc == 6) && (Tcl_GetIntFromObj(interp, argv[5], &gain) != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (!index) {
canvasPtr->scanX = x;
canvasPtr->scanXOrigin = canvasPtr->xOrigin;
canvasPtr->scanY = y;
canvasPtr->scanYOrigin = canvasPtr->yOrigin;
- } else if ((argv[2][0] == 'd')
- && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ } else {
int newXOrigin, newYOrigin, tmp;
/*
@@ -1186,30 +1657,41 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
* mouse motion.
*/
- tmp = canvasPtr->scanXOrigin - 10*(x - canvasPtr->scanX)
+ tmp = canvasPtr->scanXOrigin - gain*(x - canvasPtr->scanX)
- canvasPtr->scrollX1;
newXOrigin = canvasPtr->scrollX1 + tmp;
- tmp = canvasPtr->scanYOrigin - 10*(y - canvasPtr->scanY)
+ tmp = canvasPtr->scanYOrigin - gain*(y - canvasPtr->scanY)
- canvasPtr->scrollY1;
newYOrigin = canvasPtr->scrollY1 + tmp;
CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
- } else {
- Tcl_AppendResult(interp, "bad scan option \"", argv[2],
- "\": must be mark or dragto", (char *) NULL);
- goto error;
}
- } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)
- && (length >= 2)) {
- int index;
+ break;
+ }
+ case CANV_SELECT: {
+ int index, optionindex;
+ static char *optionStrings[] = {
+ "adjust", "clear", "from", "item", "to", NULL
+ };
+ enum options {
+ CANV_ADJUST, CANV_CLEAR, CANV_FROM, CANV_ITEM, CANV_TO
+ };
if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select option ?tagOrId? ?arg?\"", (char *) NULL);
- goto error;
+ 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;
@@ -1218,24 +1700,33 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
if (itemPtr == NULL) {
Tcl_AppendResult(interp,
"can't find an indexable and selectable item \"",
- argv[3], "\"", (char *) NULL);
- goto error;
+ Tcl_GetStringFromObj(argv[3], NULL), "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
}
if (argc == 5) {
- if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
- itemPtr, argv[4], &index) != TCL_OK) {
- goto error;
+ 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) {
+ return TCL_ERROR;
}
- length = strlen(argv[2]);
- c = argv[2][0];
- if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) {
+ switch ((enum options) optionindex) {
+ case CANV_ADJUST: {
if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select adjust tagOrId index\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
}
if (canvasPtr->textInfo.selItemPtr == itemPtr) {
if (index < (canvasPtr->textInfo.selectFirst
@@ -1248,66 +1739,78 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
}
CanvasSelectTo(canvasPtr, itemPtr, index);
- } else if ((c == 'c') && (argv[2] != NULL)
- && (strncmp(argv[2], "clear", length) == 0)) {
+ break;
+ }
+ case CANV_CLEAR: {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select clear\"", (char *) NULL);
- goto error;
+ Tcl_AppendResult(interp, 3, argv, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
if (canvasPtr->textInfo.selItemPtr != NULL) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- canvasPtr->textInfo.selItemPtr->x1,
- canvasPtr->textInfo.selItemPtr->y1,
- canvasPtr->textInfo.selItemPtr->x2,
- canvasPtr->textInfo.selItemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
canvasPtr->textInfo.selItemPtr = NULL;
}
goto done;
- } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) {
+ break;
+ }
+ case CANV_FROM: {
if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select from tagOrId index\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 3, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
}
canvasPtr->textInfo.anchorItemPtr = itemPtr;
canvasPtr->textInfo.selectAnchor = index;
- } else if ((c == 'i') && (strncmp(argv[2], "item", length) == 0)) {
+ break;
+ }
+ case CANV_ITEM: {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select item\"", (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 3, argv, (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
if (canvasPtr->textInfo.selItemPtr != NULL) {
- sprintf(interp->result, "%d",
- canvasPtr->textInfo.selItemPtr->id);
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d", canvasPtr->textInfo.selItemPtr->id);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
- } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {
+ break;
+ }
+ case CANV_TO: {
if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select to tagOrId index\"",
- (char *) NULL);
- goto error;
+ Tcl_WrongNumArgs(interp, 2, argv, "tagOrId index");
+ result = TCL_ERROR;
+ goto done;
}
CanvasSelectTo(canvasPtr, itemPtr, index);
- } else {
- Tcl_AppendResult(interp, "bad select option \"", argv[2],
- "\": must be adjust, clear, from, item, or to",
- (char *) NULL);
- goto error;
+ break;
+ }
}
- } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
+ break;
+ }
+ case CANV_TYPE: {
if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " type tag\"", (char *) NULL);
- goto error;
+ 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) {
- interp->result = itemPtr->typePtr->name;
+ Tcl_SetResult(interp, itemPtr->typePtr->name, TCL_STATIC);
}
- } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
+ break;
+ }
+ case CANV_XVIEW: {
int count, type;
int newX = 0; /* Initialization needed only to prevent
* gcc warnings. */
@@ -1317,12 +1820,15 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
PrintScrollFractions(canvasPtr->xOrigin + canvasPtr->inset,
canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin)
- canvasPtr->inset, canvasPtr->scrollX1,
- canvasPtr->scrollX2, interp->result);
+ canvasPtr->scrollX2, Tcl_GetStringResult(interp));
} else {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ char **args = GetStringsFromObjs(argc, argv);
+ type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
+ if (args) ckfree((char *) args);
switch (type) {
case TK_SCROLL_ERROR:
- goto error;
+ result = TCL_ERROR;
+ goto done;
case TK_SCROLL_MOVETO:
newX = canvasPtr->scrollX1 - canvasPtr->inset
+ (int) (fraction * (canvasPtr->scrollX2
@@ -1345,7 +1851,9 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
}
- } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
+ break;
+ }
+ case CANV_YVIEW: {
int count, type;
int newY = 0; /* Initialization needed only to prevent
* gcc warnings. */
@@ -1355,12 +1863,15 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
PrintScrollFractions(canvasPtr->yOrigin + canvasPtr->inset,
canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin)
- canvasPtr->inset, canvasPtr->scrollY1,
- canvasPtr->scrollY2, interp->result);
+ canvasPtr->scrollY2, Tcl_GetStringResult(interp));
} else {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ char **args = GetStringsFromObjs(argc, argv);
+ type = Tk_GetScrollInfo(interp, argc, args, &fraction, &count);
+ if (args) ckfree((char *) args);
switch (type) {
case TK_SCROLL_ERROR:
- goto error;
+ result = TCL_ERROR;
+ goto done;
case TK_SCROLL_MOVETO:
newY = canvasPtr->scrollY1 - canvasPtr->inset
+ (int) (fraction*(canvasPtr->scrollY2
@@ -1384,24 +1895,15 @@ CanvasWidgetCmd(clientData, interp, argc, argv)
}
CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
}
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be addtag, bbox, bind, ",
- "canvasx, canvasy, cget, configure, coords, create, ",
- "dchars, delete, dtag, find, focus, ",
- "gettags, icursor, index, insert, itemcget, itemconfigure, ",
- "lower, move, postscript, raise, scale, scan, ",
- "select, type, xview, or yview",
- (char *) NULL);
- goto error;
+ break;
+ }
}
done:
+#ifndef USE_OLD_TAG_SEARCH
+ TagSearchDestroy(searchPtr);
+#endif /* not USE_OLD_TAG_SEARCH */
Tcl_Release((ClientData) canvasPtr);
return result;
-
- error:
- Tcl_Release((ClientData) canvasPtr);
- return TCL_ERROR;
}
/*
@@ -1429,6 +1931,13 @@ DestroyCanvas(memPtr)
TkCanvas *canvasPtr = (TkCanvas *) memPtr;
Tk_Item *itemPtr;
+ if (canvasPtr->tkwin != NULL) {
+ Tcl_DeleteCommandFromToken(canvasPtr->interp, canvasPtr->widgetCmd);
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
+ }
+
/*
* Free up all of the items in the canvas.
*/
@@ -1454,11 +1963,24 @@ DestroyCanvas(memPtr)
if (canvasPtr->pixmapGC != None) {
Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
}
+#ifndef USE_OLD_TAG_SEARCH
+ {
+ TagSearchExpr *expr, *next;
+
+ 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);
}
@@ -1473,7 +1995,7 @@ DestroyCanvas(memPtr)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, border width,
@@ -1489,14 +2011,14 @@ ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
TkCanvas *canvasPtr; /* Information about widget; may or may
* not already have values for some fields. */
int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
+ 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, argv, (char *) canvasPtr, flags) != TCL_OK) {
+ argc, (char **) argv, (char *) canvasPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -1514,11 +2036,10 @@ ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
gcValues.function = GXcopy;
- gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
gcValues.graphics_exposures = False;
- new = Tk_GetGCColor(canvasPtr->tkwin,
- GCFunction|GCForeground|GCGraphicsExposures, &gcValues,
- Tk_3DBorderColor(canvasPtr->bgBorder), NULL);
+ 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);
}
@@ -1578,6 +2099,22 @@ ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
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).
@@ -1668,6 +2205,7 @@ DisplayCanvas(clientData)
if (canvasPtr->tkwin == NULL) {
return;
}
+
if (!Tk_IsMapped(tkwin)) {
goto done;
}
@@ -1689,6 +2227,20 @@ DisplayCanvas(clientData)
}
/*
+ * 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.
*/
@@ -1780,7 +2332,7 @@ DisplayCanvas(clientData)
|| (itemPtr->y1 >= screenY2)
|| (itemPtr->x2 < screenX1)
|| (itemPtr->y2 < screenY1)) {
- if (!itemPtr->typePtr->alwaysRedraw
+ if (!(itemPtr->typePtr->alwaysRedraw & 1)
|| (itemPtr->x1 >= canvasPtr->redrawX2)
|| (itemPtr->y1 >= canvasPtr->redrawY2)
|| (itemPtr->x2 < canvasPtr->redrawX1)
@@ -1788,6 +2340,11 @@ DisplayCanvas(clientData)
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);
@@ -1824,22 +2381,24 @@ DisplayCanvas(clientData)
canvasPtr->borderWidth, canvasPtr->relief);
}
if (canvasPtr->highlightWidth != 0) {
- GC gc;
-
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
if (canvasPtr->textInfo.gotFocus) {
- gc = Tk_GCForColor(canvasPtr->highlightColorPtr,
+ fgGC = Tk_GCForColor(canvasPtr->highlightColorPtr,
Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
} else {
- gc = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
- Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ canvasPtr->highlightWidth, Tk_WindowId(tkwin));
}
- Tk_DrawFocusHighlight(tkwin, gc, canvasPtr->highlightWidth,
- Tk_WindowId(tkwin));
}
}
done:
- canvasPtr->flags &= ~REDRAW_PENDING;
+ canvasPtr->flags &= ~(REDRAW_PENDING|BBOX_NOT_EMPTY);
canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
if (canvasPtr->flags & UPDATE_SCROLLBARS) {
@@ -1889,15 +2448,7 @@ CanvasEventProc(clientData, eventPtr)
canvasPtr->flags |= REDRAW_BORDERS;
}
} else if (eventPtr->type == DestroyNotify) {
- if (canvasPtr->tkwin != NULL) {
- canvasPtr->tkwin = NULL;
- Tcl_DeleteCommandFromToken(canvasPtr->interp,
- canvasPtr->widgetCmd);
- }
- if (canvasPtr->flags & REDRAW_PENDING) {
- Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
- }
- Tcl_EventuallyFree((ClientData) canvasPtr, DestroyCanvas);
+ DestroyCanvas((char *) canvasPtr);
} else if (eventPtr->type == ConfigureNotify) {
canvasPtr->flags |= UPDATE_SCROLLBARS;
@@ -1931,7 +2482,7 @@ CanvasEventProc(clientData, eventPtr)
for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
itemPtr = itemPtr->nextPtr) {
- if (itemPtr->typePtr->alwaysRedraw) {
+ if (itemPtr->typePtr->alwaysRedraw & 1) {
(*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr,
itemPtr, canvasPtr->display, None, 0, 0, 0, 0);
}
@@ -2003,10 +2554,21 @@ Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2)
* Pixels on edge are not redrawn. */
{
TkCanvas *canvasPtr = (TkCanvas *) canvas;
- if ((x1 == x2) || (y1 == y2)) {
+ /*
+ * If tkwin is NULL, the canvas has been destroyed, so we can't really
+ * redraw it.
+ */
+ if (canvasPtr->tkwin == NULL) {
return;
}
- if (canvasPtr->flags & REDRAW_PENDING) {
+
+ 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;
}
@@ -2024,6 +2586,70 @@ Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2)
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;
}
@@ -2142,10 +2768,21 @@ InitCanvas()
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
/*
*--------------------------------------------------------------
*
@@ -2172,10 +2809,10 @@ InitCanvas()
*/
static Tk_Item *
-StartTagSearch(canvasPtr, tag, searchPtr)
+StartTagSearch(canvasPtr, tagObj, searchPtr)
TkCanvas *canvasPtr; /* Canvas whose items are to be
* searched. */
- char *tag; /* String giving tag value. */
+ Tcl_Obj *tagObj; /* Object giving tag value. */
TagSearch *searchPtr; /* Record describing tag search;
* will be initialized here. */
{
@@ -2183,7 +2820,13 @@ StartTagSearch(canvasPtr, tag, searchPtr)
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.
@@ -2202,15 +2845,15 @@ StartTagSearch(canvasPtr, tag, searchPtr)
if (isdigit(UCHAR(*tag))) {
char *end;
Tcl_HashEntry *entryPtr;
-
- numIdSearches++;
+
+ dispPtr->numIdSearches++;
id = strtoul(tag, &end, 0);
if (*end == 0) {
itemPtr = canvasPtr->hotPtr;
- lastPtr = canvasPtr->hotPrevPtr;
+ lastPtr = canvasPtr->hotPrevPtr;
if ((itemPtr == NULL) || (itemPtr->id != id) || (lastPtr == NULL)
|| (lastPtr->nextPtr != itemPtr)) {
- numSlowSearches++;
+ dispPtr->numSlowSearches++;
entryPtr = Tcl_FindHashEntry(&canvasPtr->idTable, (char *) id);
if (entryPtr != NULL) {
itemPtr = (Tk_Item *)Tcl_GetHashValue(entryPtr);
@@ -2228,8 +2871,7 @@ StartTagSearch(canvasPtr, tag, searchPtr)
}
searchPtr->tag = uid = Tk_GetUid(tag);
- if (uid == allUid) {
-
+ if (uid == Tk_GetUid("all")) {
/*
* All items match.
*/
@@ -2348,6 +2990,853 @@ NextItem(searchPtr)
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 */
+
/*
*--------------------------------------------------------------
*
@@ -2363,7 +3852,7 @@ NextItem(searchPtr)
*
* Side effects:
* If tag is NULL then itemPtr's id is added as a list element
- * to interp->result; otherwise tag is added to itemPtr's
+ * to the interp's result; otherwise tag is added to itemPtr's
* list of tags.
*
*--------------------------------------------------------------
@@ -2385,7 +3874,8 @@ DoItem(interp, itemPtr, tag)
*/
if (tag == NULL) {
- char msg[30];
+ char msg[TCL_INTEGER_SPACE];
+
sprintf(msg, "%d", itemPtr->id);
Tcl_AppendElement(interp, msg);
return;
@@ -2439,9 +3929,9 @@ DoItem(interp, itemPtr, tag)
* Results:
* A standard Tcl return value. If newTag is NULL, then a
* list of ids from all the items that match argc/argv is
- * returned in interp->result. If newTag is NULL, then
- * the normal interp->result is an empty string. If an error
- * occurs, then interp->result will hold an error message.
+ * 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
@@ -2452,58 +3942,81 @@ DoItem(interp, itemPtr, tag)
*/
static int
-FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
+#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. */
- char **argv; /* Arguments that describe what items
+ Tcl_Obj *CONST *argv; /* Arguments that describe what items
* to search for (see user doc on
* "find" and "addtag" options). */
- char *newTag; /* If non-NULL, gives new tag to set
+ 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 interp->result. */
- char *cmdName; /* Name of original Tcl command, for
- * use in error messages. */
- char *option; /* For error messages: gives option
- * from Tcl command and other stuff
- * up to what's in argc/argv. */
+ * 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 */
{
- int c;
- size_t length;
+#ifdef USE_OLD_TAG_SEARCH
TagSearch search;
+#endif /* USE_OLD_TAG_SEARCH */
Tk_Item *itemPtr;
Tk_Uid uid;
+ int index;
+ static 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(newTag);
+ uid = Tk_GetUid(Tcl_GetStringFromObj(newTag, NULL));
} else {
uid = NULL;
}
- c = argv[0][0];
- length = strlen(argv[0]);
- if ((c == 'a') && (strncmp(argv[0], "above", length) == 0)
- && (length >= 2)) {
+ 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 != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " above tagOrId", (char *) NULL);
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
return TCL_ERROR;
}
- for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
+#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);
}
- } else if ((c == 'a') && (strncmp(argv[0], "all", length) == 0)
- && (length >= 2)) {
- if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " all", (char *) NULL);
+ break;
+ }
+ case CANV_ALL: {
+ if (argc != first+1) {
+ Tcl_WrongNumArgs(interp, first+1, argv, (char *) NULL);
return TCL_ERROR;
}
@@ -2511,43 +4024,53 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
itemPtr = itemPtr->nextPtr) {
DoItem(interp, itemPtr, uid);
}
- } else if ((c == 'b') && (strncmp(argv[0], "below", length) == 0)) {
+ break;
+ }
+ case CANV_BELOW: {
Tk_Item *itemPtr;
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " below tagOrId", (char *) NULL);
+ if (argc != first+2) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "tagOrId");
return TCL_ERROR;
}
- itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
- if (itemPtr->prevPtr != NULL) {
- DoItem(interp, itemPtr->prevPtr, uid);
+#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);
+ }
}
- } else if ((c == 'c') && (strncmp(argv[0], "closest", length) == 0)) {
+ break;
+ }
+ case CANV_CLOSEST: {
double closestDist;
Tk_Item *startPtr, *closestPtr;
double coords[2], halo;
int x1, y1, x2, y2;
- if ((argc < 3) || (argc > 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " closest x y ?halo? ?start?",
- (char *) NULL);
+ if ((argc < first+3) || (argc > first+5)) {
+ Tcl_WrongNumArgs(interp, first+1, argv, "x y ?halo? ?start?");
return TCL_ERROR;
}
- if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1],
- &coords[0]) != TCL_OK) || (Tk_CanvasGetCoord(interp,
- (Tk_Canvas) canvasPtr, argv[2], &coords[1]) != TCL_OK)) {
+ 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 > 3) {
- if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ 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 \"",
- argv[3], "\"", (char *) NULL);
+ Tcl_GetString(argv[3]), "\"", (char *) NULL);
return TCL_ERROR;
}
} else {
@@ -2559,8 +4082,15 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
*/
startPtr = canvasPtr->firstItemPtr;
- if (argc == 5) {
- itemPtr = StartTagSearch(canvasPtr, argv[4], &search);
+ 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;
}
@@ -2575,6 +4105,10 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
*/
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;
}
@@ -2612,6 +4146,10 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
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;
@@ -2627,36 +4165,40 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
}
}
}
- } else if ((c == 'e') && (strncmp(argv[0], "enclosed", length) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " enclosed x1 y1 x2 y2", (char *) NULL);
+ 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+1, uid, 1);
- } else if ((c == 'o') && (strncmp(argv[0], "overlapping", length) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " overlapping x1 y1 x2 y2",
- (char *) NULL);
+ return 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+1, uid, 0);
- } else if ((c == 'w') && (strncmp(argv[0], "withtag", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- cmdName, option, " withtag tagOrId", (char *) NULL);
+ return 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;
}
- for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
+#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);
}
- } else {
- Tcl_AppendResult(interp, "bad search command \"", argv[0],
- "\": must be above, all, below, closest, enclosed, ",
- "overlapping, or withtag", (char *) NULL);
- return TCL_ERROR;
+ }
}
return TCL_OK;
}
@@ -2672,9 +4214,9 @@ FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
* Results:
* A standard Tcl return value. If newTag is NULL, then a
* list of ids from all the items overlapping or enclosed
- * by the rectangle given by argc is returned in interp->result.
- * If newTag is NULL, then the normal interp->result is an
- * empty string. If an error occurs, then interp->result will
+ * 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:
@@ -2691,13 +4233,13 @@ FindArea(interp, canvasPtr, argv, uid, enclosed)
* and result storing. */
TkCanvas *canvasPtr; /* Canvas whose items are to be
* searched. */
- char **argv; /* Array of four arguments that
+ 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 interp->result. */
+ * in the interp's result. */
int enclosed; /* 0 means overlapping or enclosed
* items are OK, 1 means only enclosed
* items are OK. */
@@ -2706,13 +4248,13 @@ FindArea(interp, canvasPtr, argv, uid, enclosed)
int x1, y1, x2, y2;
Tk_Item *itemPtr;
- if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[0],
+ if ((Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[0],
&rect[0]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1],
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[1],
&rect[1]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[2],
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[2],
&rect[2]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ || (Tk_CanvasGetCoordFromObj(interp, (Tk_Canvas) canvasPtr, argv[3],
&rect[3]) != TCL_OK)) {
return TCL_ERROR;
}
@@ -2734,6 +4276,10 @@ FindArea(interp, canvasPtr, argv, uid, enclosed)
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;
@@ -2766,17 +4312,27 @@ FindArea(interp, canvasPtr, argv, uid, enclosed)
*--------------------------------------------------------------
*/
+#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. */
- char *tag; /* Tag identifying items to be moved
+ 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;
/*
@@ -2786,8 +4342,16 @@ RelinkItems(canvasPtr, tag, prevPtr)
*/
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
@@ -2818,8 +4382,7 @@ RelinkItems(canvasPtr, tag, prevPtr)
lastMovePtr->nextPtr = itemPtr;
}
lastMovePtr = itemPtr;
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1, itemPtr->y1,
- itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
canvasPtr->flags |= REPICK_NEEDED;
}
@@ -2829,7 +4392,11 @@ RelinkItems(canvasPtr, tag, prevPtr)
*/
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) {
@@ -2850,6 +4417,9 @@ RelinkItems(canvasPtr, tag, prevPtr)
if (canvasPtr->lastItemPtr == prevPtr) {
canvasPtr->lastItemPtr = lastMovePtr;
}
+#ifndef USE_OLD_TAG_SEARCH
+ return TCL_OK;
+#endif /* not USE_OLD_TAG_SEARCH */
}
/*
@@ -2967,8 +4537,9 @@ CanvasBindProc(clientData, eventPtr)
* Find the topmost item in a canvas that contains a given
* location and mark the the current item. If the current
* item has changed, generate a fake exit event on the old
- * current item and a fake enter event on the new current
- * item.
+ * 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.
@@ -2994,6 +4565,7 @@ PickCurrentItem(canvasPtr, eventPtr)
{
double coords[2];
int buttonDown;
+ Tk_Item *prevItemPtr;
/*
* Check whether or not a button is down. If so, we'll log entry
@@ -3115,7 +4687,11 @@ PickCurrentItem(canvasPtr, eventPtr)
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;
@@ -3140,12 +4716,33 @@ PickCurrentItem(canvasPtr, eventPtr)
* 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;
@@ -3159,7 +4756,8 @@ PickCurrentItem(canvasPtr, eventPtr)
* CanvasFindClosest --
*
* Given x and y coordinates, find the topmost canvas item that
- * is "close" to the coordinates.
+ * 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
@@ -3189,6 +4787,11 @@ CanvasFindClosest(canvasPtr, coords)
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;
@@ -3233,6 +4836,10 @@ CanvasDoEvent(canvasPtr, eventPtr)
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;
@@ -3246,6 +4853,7 @@ CanvasDoEvent(canvasPtr, eventPtr)
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,
@@ -3255,17 +4863,63 @@ CanvasDoEvent(canvasPtr, eventPtr)
*/
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
@@ -3320,11 +4974,8 @@ CanvasBlinkProc(clientData)
(ClientData) canvasPtr);
}
if (canvasPtr->textInfo.focusItemPtr != NULL) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- canvasPtr->textInfo.focusItemPtr->x1,
- canvasPtr->textInfo.focusItemPtr->y1,
- canvasPtr->textInfo.focusItemPtr->x2,
- canvasPtr->textInfo.focusItemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr);
}
}
@@ -3367,11 +5018,8 @@ CanvasFocusProc(canvasPtr, gotFocus)
canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
}
if (canvasPtr->textInfo.focusItemPtr != NULL) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- canvasPtr->textInfo.focusItemPtr->x1,
- canvasPtr->textInfo.focusItemPtr->y1,
- canvasPtr->textInfo.focusItemPtr->x2,
- canvasPtr->textInfo.focusItemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr);
}
if (canvasPtr->highlightWidth > 0) {
canvasPtr->flags |= REDRAW_BORDERS;
@@ -3421,11 +5069,8 @@ CanvasSelectTo(canvasPtr, itemPtr, index)
Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection,
(ClientData) canvasPtr);
} else if (canvasPtr->textInfo.selItemPtr != itemPtr) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- canvasPtr->textInfo.selItemPtr->x1,
- canvasPtr->textInfo.selItemPtr->y1,
- canvasPtr->textInfo.selItemPtr->x2,
- canvasPtr->textInfo.selItemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
}
canvasPtr->textInfo.selItemPtr = itemPtr;
@@ -3443,8 +5088,7 @@ CanvasSelectTo(canvasPtr, itemPtr, index)
if ((canvasPtr->textInfo.selectFirst != oldFirst)
|| (canvasPtr->textInfo.selectLast != oldLast)
|| (itemPtr != oldSelPtr)) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr, itemPtr);
}
}
@@ -3518,11 +5162,8 @@ CanvasLostSelection(clientData)
TkCanvas *canvasPtr = (TkCanvas *) clientData;
if (canvasPtr->textInfo.selItemPtr != NULL) {
- Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
- canvasPtr->textInfo.selItemPtr->x1,
- canvasPtr->textInfo.selItemPtr->y1,
- canvasPtr->textInfo.selItemPtr->x2,
- canvasPtr->textInfo.selItemPtr->y2);
+ EventuallyRedrawItem((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr);
}
canvasPtr->textInfo.selItemPtr = NULL;
}
@@ -3827,3 +5468,237 @@ CanvasSetOrigin(canvasPtr, xOrigin, 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 char **
+GetStringsFromObjs(argc, objv)
+ int argc;
+ Tcl_Obj *CONST objv[];
+{
+ register int i;
+ char **argv;
+ if (argc <= 0) {
+ return NULL;
+ }
+ argv = (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/tk/generic/tkCanvas.h b/tk/generic/tkCanvas.h
index 3899225a5fd..103c874aee1 100644
--- a/tk/generic/tkCanvas.h
+++ b/tk/generic/tkCanvas.h
@@ -21,6 +21,20 @@
#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
@@ -204,12 +218,23 @@ typedef struct TkCanvas {
* definitions. */
int nextId; /* Number to use as id for next item
* created in widget. */
- struct TkPostscriptInfo *psInfoPtr;
+ 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;
/*
@@ -237,6 +262,8 @@ typedef struct TkCanvas {
* 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
@@ -247,6 +274,18 @@ typedef struct TkCanvas {
#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
@@ -256,4 +295,19 @@ typedef struct TkCanvas {
extern int TkCanvPostscriptCmd _ANSI_ARGS_((TkCanvas *canvasPtr,
Tcl_Interp *interp, int argc, 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/tk/generic/tkClipboard.c b/tk/generic/tkClipboard.c
index c50a80e7c8a..c1a8c81ba5f 100644
--- a/tk/generic/tkClipboard.c
+++ b/tk/generic/tkClipboard.c
@@ -6,7 +6,7 @@
* supplied on demand to requesting applications.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -222,18 +222,18 @@ ClipboardLostSel(clientData)
*
* Take control of the clipboard and clear out the previous
* contents. This procedure must be invoked before any
- * calls to Tk_AppendToClipboard.
+ * calls to Tk_ClipboardAppend.
*
* Results:
* A standard Tcl result. If an error occurs, an error message is
- * left in interp->result.
+ * left in the interp's result.
*
* Side effects:
* From now on, requests for the CLIPBOARD selection will be
* directed to the clipboard manager routines associated with
* clipWindow for the display of tkwin. In order to guarantee
* atomicity, no event handling should occur between
- * Tk_ClipboardClear and the following Tk_AppendToClipboard
+ * 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
@@ -307,11 +307,11 @@ Tk_ClipboardClear(interp, tkwin)
* be returned. Tk_ClipboardClear must be called before a sequence
* of Tk_ClipboardAppend calls can be issued. In order to guarantee
* atomicity, no event handling should occur between Tk_ClipboardClear
- * and the following Tk_AppendToClipboard calls.
+ * and the following Tk_ClipboardAppend calls.
*
* Results:
* A standard Tcl result. If an error is returned, an error message
- * is left in interp->result.
+ * is left in the interp's result.
*
* Side effects:
* The specified buffer will be copied onto the end of the clipboard.
@@ -528,9 +528,10 @@ Tk_ClipboardCmd(clientData, interp, argc, argv)
}
return Tk_ClipboardClear(interp, tkwin);
} else {
- sprintf(interp->result,
- "bad option \"%.50s\": must be clear or append",
- argv[1]);
+ char buf[100 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad option \"%.50s\": must be clear or append", argv[1]);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
}
@@ -546,8 +547,8 @@ Tk_ClipboardCmd(clientData, interp, argc, argv)
*
* Results:
* The result is a standard Tcl return value, which is normally TCL_OK.
- * If an error occurs then an error message is left in interp->result
- * and TCL_ERROR is returned.
+ * 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.
@@ -604,3 +605,4 @@ TkClipInit(interp, dispPtr)
(ClientData) dispPtr, XA_STRING);
return TCL_OK;
}
+
diff --git a/tk/generic/tkCmds.c b/tk/generic/tkCmds.c
index b64c9809f03..78f44ca294a 100644
--- a/tk/generic/tkCmds.c
+++ b/tk/generic/tkCmds.c
@@ -5,8 +5,7 @@
* that didn't fit in any particular file of the toolkit.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * 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.
@@ -18,6 +17,14 @@
#include "tkInt.h"
#include <errno.h>
+#if defined(__WIN32__)
+#include "tkWinInt.h"
+#elif defined(MAC_TCL)
+#include "tkMacInt.h"
+#else
+#include "tkUnixInt.h"
+#endif
+
/*
* Forward declarations for procedures defined later in this file:
*/
@@ -55,12 +62,10 @@ Tk_BellObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ static char *bellOptions[] = {"-displayof", (char *) NULL};
Tk_Window tkwin = (Tk_Window) clientData;
+ char *displayName;
int index;
- char *string;
- static char *optionStrings[] = {
- "-displayof", NULL
- };
if ((objc != 1) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?");
@@ -68,12 +73,13 @@ Tk_BellObjCmd(clientData, interp, objc, objv)
}
if (objc == 3) {
- if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ if (Tcl_GetIndexFromObj(interp, objv[1], bellOptions, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
- string = Tcl_GetStringFromObj(objv[2], NULL);
- tkwin = Tk_NameToWindow(interp, string, tkwin);
+ displayName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+
+ tkwin = Tk_NameToWindow(interp, displayName, tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -154,7 +160,7 @@ Tk_BindCmd(clientData, interp, argc, argv)
Tcl_ResetResult(interp);
return TCL_OK;
}
- interp->result = command;
+ Tcl_SetResult(interp, command, TCL_STATIC);
} else {
Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
}
@@ -186,7 +192,6 @@ TkBindEventProc(winPtr, eventPtr)
{
#define MAX_OBJS 20
ClientData objects[MAX_OBJS], *objPtr;
- static Tk_Uid allUid = NULL;
TkWindow *topLevPtr;
int i, count;
char *p;
@@ -234,10 +239,7 @@ TkBindEventProc(winPtr, eventPtr)
} else {
count = 3;
}
- if (allUid == NULL) {
- allUid = Tk_GetUid("all");
- }
- objPtr[count-1] = (ClientData) allUid;
+ objPtr[count-1] = (ClientData) Tk_GetUid("all");
}
Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
count, objPtr);
@@ -383,7 +385,7 @@ TkFreeBindingTags(winPtr)
/*
*----------------------------------------------------------------------
*
- * Tk_DestroyCmd --
+ * Tk_DestroyObjCmd --
*
* This procedure is invoked to process the "destroy" Tcl command.
* See the user documentation for details on what it does.
@@ -398,19 +400,19 @@ TkFreeBindingTags(winPtr)
*/
int
-Tk_DestroyCmd(clientData, interp, argc, argv)
+Tk_DestroyObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ 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 < argc; i++) {
- window = Tk_NameToWindow(interp, argv[i], tkwin);
+ for (i = 1; i < objc; i++) {
+ window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
if (window == NULL) {
Tcl_ResetResult(interp);
continue;
@@ -432,7 +434,7 @@ Tk_DestroyCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * Tk_LowerCmd --
+ * Tk_LowerObjCmd --
*
* This procedure is invoked to process the "lower" Tcl command.
* See the user documentation for details on what it does.
@@ -448,37 +450,37 @@ Tk_DestroyCmd(clientData, interp, argc, argv)
/* ARGSUSED */
int
-Tk_LowerCmd(clientData, interp, argc, argv)
+Tk_LowerObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tk_Window mainwin = (Tk_Window) clientData;
Tk_Window tkwin, other;
- if ((argc != 2) && (argc != 3)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " window ?belowThis?\"", (char *) NULL);
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
return TCL_ERROR;
}
- tkwin = Tk_NameToWindow(interp, argv[1], mainwin);
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
- if (argc == 2) {
+ if (objc == 2) {
other = NULL;
} else {
- other = Tk_NameToWindow(interp, argv[2], mainwin);
+ 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 \"", argv[1], "\" below \"",
- argv[2], "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
+ "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
+ "\"", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -487,7 +489,7 @@ Tk_LowerCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * Tk_RaiseCmd --
+ * Tk_RaiseObjCmd --
*
* This procedure is invoked to process the "raise" Tcl command.
* See the user documentation for details on what it does.
@@ -503,37 +505,37 @@ Tk_LowerCmd(clientData, interp, argc, argv)
/* ARGSUSED */
int
-Tk_RaiseCmd(clientData, interp, argc, argv)
+Tk_RaiseObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tk_Window mainwin = (Tk_Window) clientData;
Tk_Window tkwin, other;
- if ((argc != 2) && (argc != 3)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " window ?aboveThis?\"", (char *) NULL);
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
return TCL_ERROR;
}
- tkwin = Tk_NameToWindow(interp, argv[1], mainwin);
+ tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
- if (argc == 2) {
+ if (objc == 2) {
other = NULL;
} else {
- other = Tk_NameToWindow(interp, argv[2], mainwin);
+ 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 \"", argv[1], "\" above \"",
- argv[2], "\"", (char *) NULL);
+ Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
+ "\" above \"", (other ? Tcl_GetString(objv[2]) : ""),
+ "\"", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -566,10 +568,10 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
int index;
Tk_Window tkwin;
static char *optionStrings[] = {
- "appname", "scaling", NULL
+ "appname", "scaling", "useinputmethods", NULL
};
enum options {
- TK_APPNAME, TK_SCALING
+ TK_APPNAME, TK_SCALING, TK_USE_IM
};
tkwin = (Tk_Window) clientData;
@@ -598,14 +600,14 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
string = Tcl_GetStringFromObj(objv[2], NULL);
winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), winPtr->nameUid, -1);
+ Tcl_AppendResult(interp, winPtr->nameUid, NULL);
break;
}
case TK_SCALING: {
Screen *screenPtr;
int skip, width, height;
double d;
-
+
screenPtr = Tk_Screen(tkwin);
skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
@@ -618,7 +620,7 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
d /= WidthMMOfScreen(screenPtr);
Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
} else if (objc - skip == 3) {
- if (Tcl_GetDoubleFromObj(interp, objv[2 + skip], &d) != TCL_OK) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
return TCL_ERROR;
}
d = (25.4 / 72) / d;
@@ -639,6 +641,40 @@ Tk_TkObjCmd(clientData, interp, objc, objv)
}
break;
}
+ case TK_USE_IM: {
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ int skip;
+
+ 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 bool;
+ if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &bool)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+#ifdef TK_USE_INPUT_METHODS
+ dispPtr->useInputMethods = bool;
+#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),
+ dispPtr->useInputMethods);
+ break;
+ }
}
return TCL_OK;
}
@@ -800,7 +836,7 @@ WaitWindowProc(clientData, eventPtr)
/*
*----------------------------------------------------------------------
*
- * Tk_UpdateCmd --
+ * Tk_UpdateObjCmd --
*
* This procedure is invoked to process the "update" Tcl command.
* See the user documentation for details on what it does.
@@ -816,28 +852,27 @@ WaitWindowProc(clientData, eventPtr)
/* ARGSUSED */
int
-Tk_UpdateCmd(clientData, interp, argc, argv)
+Tk_UpdateObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int flags;
+ static char *updateOptions[] = {"idletasks", (char *) NULL};
+ int flags, index;
TkDisplay *dispPtr;
- if (argc == 1) {
+ if (objc == 1) {
flags = TCL_DONT_WAIT;
- } else if (argc == 2) {
- if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be idletasks", (char *) NULL);
+ } 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_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " ?idletasks?\"", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
return TCL_ERROR;
}
@@ -849,12 +884,12 @@ Tk_UpdateCmd(clientData, interp, argc, argv)
* Thus, don't use any information from tkwin after calling
* Tcl_DoOneEvent.
*/
-
+
while (1) {
while (Tcl_DoOneEvent(flags) != 0) {
/* Empty loop body */
}
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
XSync(dispPtr->display, False);
}
@@ -898,10 +933,10 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int index, x, y, width, height, useX, useY, class, skip;
- char buf[128];
char *string;
TkWindow *winPtr;
Tk_Window tkwin;
+ Tcl_Obj *resultPtr;
static TkStateMap visualMap[] = {
{PseudoColor, "pseudocolor"},
@@ -974,85 +1009,73 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
}
}
winPtr = (TkWindow *) tkwin;
+ resultPtr = Tcl_GetObjResult(interp);
switch ((enum options) index) {
case WIN_CELLS: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- Tk_Visual(tkwin)->map_entries);
+ Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
break;
}
case WIN_CHILDREN: {
Tcl_Obj *strPtr;
- Tcl_ResetResult(interp);
winPtr = winPtr->childList;
for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
- Tcl_ListObjAppendElement(NULL,
- Tcl_GetObjResult(interp), strPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
break;
}
case WIN_CLASS: {
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Class(tkwin), -1);
+ Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
break;
}
case WIN_COLORMAPFULL: {
- Tcl_ResetResult(interp);
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
+ Tcl_SetBooleanObj(resultPtr,
TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
break;
}
case WIN_DEPTH: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Depth(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
break;
}
case WIN_GEOMETRY: {
- Tcl_ResetResult(interp);
+ 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(Tcl_GetObjResult(interp), buf, -1);
+ Tcl_SetStringObj(resultPtr, buf, -1);
break;
}
case WIN_HEIGHT: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Height(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
break;
}
case WIN_ID: {
+ char buf[TCL_INTEGER_SPACE];
+
Tk_MakeWindowExist(tkwin);
TkpPrintWindowId(buf, Tk_WindowId(tkwin));
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ Tcl_SetStringObj(resultPtr, buf, -1);
break;
}
case WIN_ISMAPPED: {
- Tcl_ResetResult(interp);
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
- (int) Tk_IsMapped(tkwin));
+ Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
break;
}
case WIN_MANAGER: {
- Tcl_ResetResult(interp);
if (winPtr->geomMgrPtr != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- winPtr->geomMgrPtr->name, -1);
+ Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
}
break;
}
case WIN_NAME: {
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp), Tk_Name(tkwin), -1);
+ Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
break;
}
case WIN_PARENT: {
- Tcl_ResetResult(interp);
if (winPtr->parentPtr != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- winPtr->parentPtr->pathName, -1);
+ Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
}
break;
}
@@ -1078,80 +1101,66 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
} else {
TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
}
- Tcl_ResetResult(interp);
if (useX & useY) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
sprintf(buf, "%d %d", x, y);
- Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ Tcl_SetStringObj(resultPtr, buf, -1);
} else if (useX) {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
+ Tcl_SetIntObj(resultPtr, x);
} else {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
+ Tcl_SetIntObj(resultPtr, y);
}
break;
}
case WIN_REQHEIGHT: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqHeight(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
break;
}
case WIN_REQWIDTH: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_ReqWidth(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
break;
}
case WIN_ROOTX: {
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
+ Tcl_SetIntObj(resultPtr, x);
break;
}
case WIN_ROOTY: {
Tk_GetRootCoords(tkwin, &x, &y);
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
+ Tcl_SetIntObj(resultPtr, y);
break;
}
case WIN_SCREEN: {
+ char buf[TCL_INTEGER_SPACE];
+
sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- Tk_DisplayName(tkwin), ".", buf, NULL);
+ Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",
+ buf, NULL);
break;
}
case WIN_SCREENCELLS: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- CellsOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
break;
}
case WIN_SCREENDEPTH: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- DefaultDepthOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
break;
}
case WIN_SCREENHEIGHT: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- HeightOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
break;
}
case WIN_SCREENWIDTH: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- WidthOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
break;
}
case WIN_SCREENMMHEIGHT: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- HeightMMOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
break;
}
case WIN_SCREENMMWIDTH: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp),
- WidthMMOfScreen(Tk_Screen(tkwin)));
+ Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
break;
}
case WIN_SCREENVISUAL: {
@@ -1165,16 +1174,12 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
case WIN_TOPLEVEL: {
winPtr = GetToplevel(tkwin);
if (winPtr != NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- winPtr->pathName, -1);
+ Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
}
break;
}
case WIN_VIEWABLE: {
- int viewable;
-
- viewable = 0;
+ int viewable = 0;
for ( ; ; winPtr = winPtr->parentPtr) {
if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
break;
@@ -1184,8 +1189,8 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
break;
}
}
- Tcl_ResetResult(interp);
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp), viewable);
+
+ Tcl_SetBooleanObj(resultPtr, viewable);
break;
}
case WIN_VISUAL: {
@@ -1196,54 +1201,47 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
if (string == NULL) {
string = "unknown";
}
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp), string, -1);
+ Tcl_SetStringObj(resultPtr, string, -1);
break;
}
case WIN_VISUALID: {
- Tcl_ResetResult(interp);
+ char buf[TCL_INTEGER_SPACE];
+
sprintf(buf, "0x%x",
(unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
- Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ Tcl_SetStringObj(resultPtr, buf, -1);
break;
}
case WIN_VROOTHEIGHT: {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), height);
+ Tcl_SetIntObj(resultPtr, height);
break;
}
case WIN_VROOTWIDTH: {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), width);
+ Tcl_SetIntObj(resultPtr, width);
break;
}
case WIN_VROOTX: {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), x);
+ Tcl_SetIntObj(resultPtr, x);
break;
}
case WIN_VROOTY: {
Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), y);
+ Tcl_SetIntObj(resultPtr, y);
break;
}
case WIN_WIDTH: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Width(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
break;
}
case WIN_X: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_X(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
break;
}
case WIN_Y: {
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_Y(tkwin));
+ Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
break;
}
@@ -1262,9 +1260,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
}
objv += skip;
string = Tcl_GetStringFromObj(objv[2], NULL);
- Tcl_ResetResult(interp);
- Tcl_SetLongObj(Tcl_GetObjResult(interp),
- (long) Tk_InternAtom(tkwin, string));
+ Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
break;
}
case WIN_ATOMNAME: {
@@ -1283,15 +1279,14 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
name = Tk_GetAtomName(tkwin, (Atom) id);
if (strcmp(name, "?bad atom?") == 0) {
string = Tcl_GetStringFromObj(objv[2], NULL);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendStringsToObj(resultPtr,
"no atom exists with id \"", string, "\"", NULL);
return TCL_ERROR;
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+ Tcl_SetStringObj(resultPtr, name, -1);
break;
}
case WIN_CONTAINING: {
@@ -1315,9 +1310,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
}
tkwin = Tk_CoordsToWindow(x, y, tkwin);
if (tkwin != NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- Tk_PathName(tkwin), -1);
+ Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
}
break;
}
@@ -1354,9 +1347,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
if ((winPtr == NULL) ||
(winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "window id \"", string,
+ Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
"\" doesn't exist in this application", (char *) NULL);
return TCL_ERROR;
}
@@ -1369,9 +1360,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
tkwin = (Tk_Window) winPtr;
if (Tk_PathName(tkwin) != NULL) {
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
- Tk_PathName(tkwin), -1);
+ Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
}
break;
}
@@ -1389,12 +1378,14 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
}
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_ResetResult(interp); /* clear any error msg */
- Tcl_SetBooleanObj(Tcl_GetObjResult(interp), alive);
+ Tcl_SetBooleanObj(resultPtr, alive);
break;
}
case WIN_FPIXELS: {
@@ -1414,9 +1405,8 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
- / WidthMMOfScreen(Tk_Screen(tkwin));
- Tcl_ResetResult(interp);
- Tcl_SetDoubleObj(Tcl_GetObjResult(interp), pixels);
+ / WidthMMOfScreen(Tk_Screen(tkwin));
+ Tcl_SetDoubleObj(resultPtr, pixels);
break;
}
case WIN_PIXELS: {
@@ -1435,12 +1425,12 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), pixels);
+ 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");
@@ -1459,16 +1449,16 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
colorPtr->blue);
Tk_FreeColor(colorPtr);
- Tcl_ResetResult(interp);
- Tcl_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ Tcl_SetStringObj(resultPtr, buf, -1);
break;
}
case WIN_VISUALSAVAILABLE: {
XVisualInfo template, *visInfoPtr;
int count, i;
- char visualIdString[16];
int includeVisualId;
Tcl_Obj *strPtr;
+ char buf[16 + TCL_INTEGER_SPACE];
+ char visualIdString[TCL_INTEGER_SPACE];
if (objc == 3) {
includeVisualId = 0;
@@ -1490,9 +1480,8 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
template.screen = Tk_ScreenNumber(tkwin);
visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
&template, &count);
- Tcl_ResetResult(interp);
if (visInfoPtr == NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ Tcl_SetStringObj(resultPtr,
"can't find any visuals for screen", -1);
return TCL_ERROR;
}
@@ -1509,8 +1498,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
strcat(buf, visualIdString);
}
strPtr = Tcl_NewStringObj(buf, -1);
- Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
- strPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
XFree((char *) visInfoPtr);
break;
@@ -1519,6 +1507,221 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv)
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 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) {
+ 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->wmTracing));
+ return TCL_OK;
+ }
+ return Tcl_GetBooleanFromObj(interp, objv[2], &dispPtr->wmTracing);
+ }
+
+ 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
+
/*
*----------------------------------------------------------------------
*
@@ -1567,7 +1770,8 @@ TkGetDisplayOf(interp, objc, objv, tkwinPtr)
return 0;
}
string = Tcl_GetStringFromObj(objv[0], &length);
- if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) {
+ if ((length >= 2) &&
+ (strncmp(string, "-displayof", (unsigned) length) == 0)) {
if (objc < 2) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
"value for \"-displayof\" missing", -1);
@@ -1647,3 +1851,5 @@ GetToplevel(tkwin)
}
return winPtr;
}
+
+
diff --git a/tk/generic/tkColor.c b/tk/generic/tkColor.c
index c5844781015..19659fcf159 100644
--- a/tk/generic/tkColor.c
+++ b/tk/generic/tkColor.c
@@ -6,7 +6,7 @@
* map color names to pixel values.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -14,72 +14,149 @@
* RCS: @(#) $Id$
*/
-#include <tkColor.h>
+#include "tkColor.h"
/*
- * A two-level data structure is used to manage the color database.
- * The top level consists of one entry for each color name that is
- * currently active, and the bottom level contains one entry for each
- * pixel value that is still in use. The distinction between
- * levels is necessary because the same pixel may have several
- * different names. There are two hash tables, one used to index into
- * each of the data structures. The name hash table is used when
- * allocating colors, and the pixel hash table is used when freeing
- * colors.
+ * Structures of the following following type are used as keys for
+ * colorValueTable (in TkDisplay).
*/
-
-/*
- * Hash table for name -> TkColor mapping, and key structure used to
- * index into that table:
- */
-
-static Tcl_HashTable nameTable;
typedef struct {
- Tk_Uid name; /* Name of desired color. */
+ int red, green, blue; /* Values for desired color. */
Colormap colormap; /* Colormap from which color will be
* allocated. */
Display *display; /* Display for colormap. */
-} NameKey;
+} ValueKey;
+
/*
- * Hash table for value -> TkColor mapping, and key structure used to
- * index into that table:
+ * The structure below is used to allocate thread-local data.
*/
-static Tcl_HashTable valueTable;
-typedef struct {
- int red, green, blue; /* Values for desired color. */
- Colormap colormap; /* Colormap from which color will be
- * allocated. */
- Display *display; /* Display for colormap. */
-} ValueKey;
-
-static int initialized = 0; /* 0 means static structures haven't been
- * initialized yet. */
+typedef struct ThreadSpecificData {
+ char rgbString[20]; /* */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* Forward declarations for procedures defined in this file:
*/
-static void ColorInit _ANSI_ARGS_((void));
+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));
-/* CYGNUS LOCAL. */
-
-/* A linked list of GC structures. */
+/*
+ * 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.
+ */
-struct TkGCList {
- /* Next item on list. */
- TkGCList *next;
- /* The display for the GC. */
- Display *display;
- /* The GC. */
- GC gc;
- /* GCForeground or GCBackground. */
- unsigned long mask;
+static Tcl_ObjType colorObjType = {
+ "color", /* name */
+ FreeColorObjProc, /* freeIntRepProc */
+ DupColorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AllocColorFromObj --
+ *
+ * Given a Tcl_Obj *, map the value to a corresponding
+ * XColor structure based on the tkwin given.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the red, blue, and green intensities for the color
+ * given by the string in objPtr, and also specifies a pixel value
+ * to use to draw in that color. If an error occurs, NULL is
+ * returned and an error message will be left in interp's result
+ * (unless interp is NULL).
+ *
+ * Side effects:
+ * The color is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeColorFromObj so that the database is cleaned up when colors
+ * aren't in use anymore.
+ *
+ *----------------------------------------------------------------------
+ */
-/* END CYGNUS LOCAL */
+XColor *
+Tk_AllocColorFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Used only for error reporting. If NULL,
+ * then no messages are provided. */
+ Tk_Window tkwin; /* Window in which the color will be used.*/
+ Tcl_Obj *objPtr; /* Object that describes the color; string
+ * value is a color name such as "red" or
+ * "#ff0000".*/
+{
+ TkColor *tkColPtr;
+
+ if (objPtr->typePtr != &colorObjType) {
+ InitColorObj(objPtr);
+ }
+ tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkColor, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (tkColPtr != NULL) {
+ if (tkColPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkColor that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeColorObjProc(objPtr);
+ tkColPtr = NULL;
+ } else if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ return (XColor *) tkColPtr;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkColor that we wanted. Search
+ * the list of TkColors with the same name to see if one of the
+ * other TkColors is the right one.
+ */
+
+ if (tkColPtr != NULL) {
+ TkColor *firstColorPtr =
+ (TkColor *) Tcl_GetHashValue(tkColPtr->hashPtr);
+ FreeColorObjProc(objPtr);
+ for (tkColPtr = firstColorPtr; tkColPtr != NULL;
+ tkColPtr = tkColPtr->nextPtr) {
+ if ((Tk_Screen(tkwin) == tkColPtr->screen)
+ && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+ tkColPtr->resourceRefCount++;
+ tkColPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ return (XColor *) tkColPtr;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call Tk_GetColor to allocate a new TkColor object.
+ */
+
+ tkColPtr = (TkColor *) Tk_GetColor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
+ }
+ return (XColor *) tkColPtr;
+}
/*
*----------------------------------------------------------------------
@@ -94,7 +171,7 @@ struct TkGCList {
* indicates the red, blue, and green intensities for the color
* given by "name", and also specifies a pixel value to use to
* draw in that color. If an error occurs, NULL is returned and
- * an error message will be left in interp->result.
+ * 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.
@@ -110,17 +187,17 @@ Tk_GetColor(interp, tkwin, name)
Tcl_Interp *interp; /* Place to leave error message if
* color can't be found. */
Tk_Window tkwin; /* Window in which color will be used. */
- Tk_Uid name; /* Name of color to allocated (in form
+ char *name; /* Name of color to be allocated (in form
* suitable for passing to XParseColor). */
{
- NameKey nameKey;
Tcl_HashEntry *nameHashPtr;
int new;
TkColor *tkColPtr;
- Display *display = Tk_Display(tkwin);
+ TkColor *existingColPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- ColorInit();
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
}
/*
@@ -128,14 +205,19 @@ Tk_GetColor(interp, tkwin, name)
* name.
*/
- nameKey.name = name;
- nameKey.colormap = Tk_Colormap(tkwin);
- nameKey.display = display;
- nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->colorNameTable, name, &new);
if (!new) {
- tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
- tkColPtr->refCount++;
- return &tkColPtr->color;
+ 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;
}
/*
@@ -154,22 +236,27 @@ Tk_GetColor(interp, tkwin, name)
"\"", (char *) NULL);
}
}
- Tcl_DeleteHashEntry(nameHashPtr);
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
return (XColor *) NULL;
}
/*
- * Now create a new TkColor structure and add it to nameTable.
+ * 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 = nameKey.colormap;
+ tkColPtr->colormap = Tk_Colormap(tkwin);
tkColPtr->visual = Tk_Visual(tkwin);
- tkColPtr->refCount = 1;
- tkColPtr->tablePtr = &nameTable;
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_NAME;
tkColPtr->hashPtr = nameHashPtr;
+ tkColPtr->nextPtr = existingColPtr;
tkColPtr->gcList = NULL;
Tcl_SetHashValue(nameHashPtr, tkColPtr);
@@ -211,9 +298,10 @@ Tk_GetColorByValue(tkwin, colorPtr)
int new;
TkColor *tkColPtr;
Display *display = Tk_Display(tkwin);
+ TkDisplay *dispPtr = TkGetDisplay(display);
- if (!initialized) {
- ColorInit();
+ if (!dispPtr->colorInit) {
+ ColorInit(dispPtr);
}
/*
@@ -226,16 +314,17 @@ Tk_GetColorByValue(tkwin, colorPtr)
valueKey.blue = colorPtr->blue;
valueKey.colormap = Tk_Colormap(tkwin);
valueKey.display = display;
- valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->colorValueTable,
+ (char *) &valueKey, &new);
if (!new) {
tkColPtr = (TkColor *) Tcl_GetHashValue(valueHashPtr);
- tkColPtr->refCount++;
+ tkColPtr->resourceRefCount++;
return &tkColPtr->color;
}
/*
* The name isn't currently known. Find a pixel value for this
- * color and add a new structure to valueTable.
+ * color and add a new structure to colorValueTable (in TkDisplay).
*/
tkColPtr = TkpGetColorByValue(tkwin, colorPtr);
@@ -244,9 +333,11 @@ Tk_GetColorByValue(tkwin, colorPtr)
tkColPtr->screen = Tk_Screen(tkwin);
tkColPtr->colormap = valueKey.colormap;
tkColPtr->visual = Tk_Visual(tkwin);
- tkColPtr->refCount = 1;
- tkColPtr->tablePtr = &valueTable;
+ tkColPtr->resourceRefCount = 1;
+ tkColPtr->objRefCount = 0;
+ tkColPtr->type = TK_COLOR_BY_VALUE;
tkColPtr->hashPtr = valueHashPtr;
+ tkColPtr->nextPtr = NULL;
tkColPtr->gcList = NULL;
Tcl_SetHashValue(valueHashPtr, tkColPtr);
return &tkColPtr->color;
@@ -279,15 +370,17 @@ Tk_NameOfColor(colorPtr)
XColor *colorPtr; /* Color whose name is desired. */
{
register TkColor *tkColPtr = (TkColor *) colorPtr;
- static char string[20];
-
- if ((tkColPtr->magic == COLOR_MAGIC)
- && (tkColPtr->tablePtr == &nameTable)) {
- return ((NameKey *) tkColPtr->hashPtr->key.words)->name;
+
+ 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;
}
- sprintf(string, "#%04x%04x%04x", colorPtr->red, colorPtr->green,
- colorPtr->blue);
- return string;
}
/*
@@ -314,8 +407,7 @@ Tk_NameOfColor(colorPtr)
GC
Tk_GCForColor(colorPtr, drawable)
XColor *colorPtr; /* Color for which a GC is desired. Must
- * have been allocated by Tk_GetColor or
- * Tk_GetColorByName. */
+ * 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
@@ -366,8 +458,9 @@ Tk_FreeColor(colorPtr)
* allocated by Tk_GetColor or
* Tk_GetColorByValue. */
{
- register TkColor *tkColPtr = (TkColor *) colorPtr;
+ TkColor *tkColPtr = (TkColor *) colorPtr;
Screen *screen = tkColPtr->screen;
+ TkColor *prevPtr;
/*
* Do a quick sanity check to make sure this color was really
@@ -378,15 +471,45 @@ Tk_FreeColor(colorPtr)
panic("Tk_FreeColor called with bogus color");
}
- tkColPtr->refCount--;
- if (tkColPtr->refCount == 0) {
- if (tkColPtr->gc != None) {
- XFreeGC(DisplayOfScreen(screen), tkColPtr->gc);
- tkColPtr->gc = None;
+ 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;
}
- TkpFreeColor(tkColPtr);
- Tcl_DeleteHashEntry(tkColPtr->hashPtr);
- tkColPtr->magic = 0;
+ 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);
}
}
@@ -394,131 +517,300 @@ Tk_FreeColor(colorPtr)
/*
*----------------------------------------------------------------------
*
- * ColorInit --
+ * Tk_FreeColorFromObj --
*
- * Initialize the structure used for color management.
+ * 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:
- * Read the code.
+ * 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.
*
*----------------------------------------------------------------------
*/
-static void
-ColorInit()
+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. */
{
- initialized = 1;
- Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
- Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
+ Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
+ FreeColorObjProc(objPtr);
}
-/* CYGNUS LOCAL: Call a function on every named color. This is used
- on Windows to change the colors when the user changes them via the
- control panel. */
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *---------------------------------------------------------------------------
+ */
-void
-TkMapOverColors(func)
- void (*func) _ANSI_ARGS_((TkColor *));
+static void
+FreeColorObjProc(objPtr)
+ Tcl_Obj *objPtr; /* The object we are releasing. */
{
- Tcl_HashEntry *nameHashPtr;
- Tcl_HashSearch search;
- TkColor *tkColPtr;
+ TkColor *tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
- nameHashPtr = Tcl_FirstHashEntry(&nameTable, &search);
- while (nameHashPtr != NULL) {
- tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
- (*func)(tkColPtr);
- nameHashPtr = Tcl_NextHashEntry(&search);
+ 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.
+ *
+ *---------------------------------------------------------------------------
+ */
-/* CYGNUS LOCAL: For each color, we keep a list of GCs that use that
- color as the foreground or background. This is so that we can
- change them on Windows when the user changes the system colors. */
-
-void
-TkRegisterColorGC(colorPtr, display, gc, valueMask)
- XColor *colorPtr;
- Display *display;
- GC gc;
- unsigned long valueMask;
+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 *) colorPtr;
- TkGCList *gcListPtr;
+ TkColor *tkColPtr = (TkColor *) srcObjPtr->internalRep.twoPtrValue.ptr1;
+
+ dupObjPtr->typePtr = srcObjPtr->typePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
- if (tkColPtr->magic != COLOR_MAGIC) {
- return;
+ if (tkColPtr != NULL) {
+ tkColPtr->objRefCount++;
}
-
- gcListPtr = (TkGCList *) ckalloc(sizeof(TkGCList));
- gcListPtr->display = display;
- gcListPtr->gc = gc;
- gcListPtr->mask = valueMask;
- gcListPtr->next = tkColPtr->gcList;
- tkColPtr->gcList = gcListPtr;
-
- /* Each GC added to the list counts as a reference to the color,
- so that we don't free the color before freeing the GC. */
-
- tkColPtr->refCount++;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
-/* This is called when a GC with a registered color is deleted. */
-
-void
-TkDeregisterColorGC(colorPtr, gc, valueMask)
- XColor *colorPtr;
- GC gc;
- unsigned long valueMask;
+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 = (TkColor *) colorPtr;
- TkGCList **gcListPtrPtr, *gcListPtr;
+ TkColor *tkColPtr;
+ Tcl_HashEntry *hashPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (tkColPtr->magic != COLOR_MAGIC) {
- return;
+ if (objPtr->typePtr != &colorObjType) {
+ 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;
}
- for (gcListPtrPtr = &tkColPtr->gcList;
- *gcListPtrPtr != NULL;
- gcListPtrPtr = &(*gcListPtrPtr)->next) {
- if ((*gcListPtrPtr)->gc == gc && (*gcListPtrPtr)->mask == valueMask) {
- gcListPtr = *gcListPtrPtr;
- *gcListPtrPtr = gcListPtr->next;
- ckfree((char *) gcListPtr);
- Tk_FreeColor((XColor *) tkColPtr);
- break;
+ /*
+ * 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;
}
}
-}
-/* This is called when a color is changed by the user on Windows. */
+ 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).
+ *
+ *----------------------------------------------------------------------
+ */
-void
-TkColorChanged(tkColPtr)
- TkColor *tkColPtr;
+static void
+InitColorObj(objPtr)
+ Tcl_Obj *objPtr; /* The object to convert. */
{
- TkGCList *gcListPtr;
- XGCValues gcValues;
+ Tcl_ObjType *typePtr;
- for (gcListPtr = tkColPtr->gcList;
- gcListPtr != NULL;
- gcListPtr = gcListPtr->next) {
- if (gcListPtr->mask == GCForeground) {
- gcValues.foreground = tkColPtr->color.pixel;
- } else {
- gcValues.background = tkColPtr->color.pixel;
- }
+ /*
+ * Free the old internalRep before setting the new one.
+ */
- XChangeGC(gcListPtr->display, gcListPtr->gc, gcListPtr->mask,
- &gcValues);
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
}
+ objPtr->typePtr = &colorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ColorInit --
+ *
+ * Initialize the structure used for color management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
- if (tkColPtr->gc != None) {
- gcValues.foreground = tkColPtr->color.pixel;
- XChangeGC(DisplayOfScreen(tkColPtr->screen), tkColPtr->gc,
- GCForeground, &gcValues);
+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/tk/generic/tkColor.h b/tk/generic/tkColor.h
index 8a72d7eb9e3..2f38ac4db65 100644
--- a/tk/generic/tkColor.h
+++ b/tk/generic/tkColor.h
@@ -4,7 +4,7 @@
* Declarations of data types and functions used by the
* Tk color module.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * 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.
@@ -23,14 +23,31 @@
#endif
/* CYGNUS LOCAL. */
-typedef struct TkGCList TkGCList;
+
+/* A linked list of GC structures. */
+
+typedef struct TkGCList {
+ /* Next item on list. */
+ struct TkGCList *next;
+ /* The display for the GC. */
+ Display *display;
+ /* The GC. */
+ GC gc;
+ /* GCForeground or GCBackground. */
+ unsigned long mask;
+} TkGCList;
+
+/* END CYGNUS LOCAL */
/*
* One of the following data structures is used to keep track of
- * each color that the color module has allocated from the X display
- * server.
+ * 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 {
@@ -46,11 +63,29 @@ typedef struct TkColor {
Colormap colormap; /* Colormap from which this entry was
* allocated. */
Visual *visual; /* Visual associated with colormap. */
- int refCount; /* Number of uses of this structure. */
- Tcl_HashTable *tablePtr; /* Hash table that indexes this structure
- * (needed when deleting structure). */
+ 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. */
/* CYGNUS LOCAL */
TkGCList *gcList; /* List of GCs which use this color. */
} TkColor;
@@ -75,3 +110,4 @@ EXTERN void TkColorChanged _ANSI_ARGS_((TkColor *));
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKCOLOR */
+
diff --git a/tk/generic/tkConfig.c b/tk/generic/tkConfig.c
index 4efac5e9089..f12893607c7 100644
--- a/tk/generic/tkConfig.c
+++ b/tk/generic/tkConfig.c
@@ -1,10 +1,10 @@
/*
* tkConfig.c --
*
- * This file contains the Tk_ConfigureWidget procedure.
+ * This file contains procedures that manage configuration options
+ * for widgets and other things.
*
- * Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -12,568 +12,1625 @@
* RCS: @(#) $Id$
*/
-#include "tkPort.h"
+/*
+ * 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"
/*
- * 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!
+ * 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. */
+ } extra;
+ int flags; /* Miscellaneous flag values; see
+ * below for definitions. */
+} Option;
+
+/*
+ * Flag bits defined for Option structures:
*
- * INIT - Non-zero means (char *) things have been
- * converted to Tk_Uid's.
+ * OPTION_NEEDS_FREEING - 1 means that FreeResources must be
+ * invoke to free resources associated with
+ * the option when it is no longer needed.
*/
-#define INIT 0x20
+#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 DoConfig _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_ConfigSpec *specPtr,
- Tk_Uid value, int valueIsUid, char *widgRec));
-static Tk_ConfigSpec * FindConfigSpec _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_ConfigSpec *specs, char *argvName,
- int needFlags, int hateFlags));
-static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_ConfigSpec *specPtr,
- char *widgRec));
-static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_ConfigSpec *specPtr,
- char *widgRec, char *buffer,
- Tcl_FreeProc **freeProcPtr));
+static int DoObjConfig _ANSI_ARGS_((Tcl_Interp *interp,
+ char *recordPtr, Option *optionPtr,
+ Tcl_Obj *valuePtr, Tk_Window tkwin,
+ Tk_SavedOption *savePtr));
+static void DestroyOptionHashTable _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+static void FreeResources _ANSI_ARGS_((Option *optionPtr,
+ Tcl_Obj *objPtr, char *internalPtr,
+ Tk_Window tkwin));
+static Tcl_Obj * GetConfigList _ANSI_ARGS_((char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin));
+static Tcl_Obj * GetObjectForOption _ANSI_ARGS_((char *recordPtr,
+ Option *optionPtr, Tk_Window tkwin));
+static Option * GetOptionFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, OptionTable *tablePtr));
+static int ObjectIsEmpty _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetOptionFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The structure below defines an object type that is used to cache the
+ * result of looking up an option name. If an object has this type, then
+ * its internalPtr1 field points to the OptionTable in which it was looked up,
+ * and the internalPtr2 field points to the entry that matched.
+ */
+
+Tcl_ObjType optionType = {
+ "option", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ SetOptionFromAny /* setFromAnyProc */
+};
/*
*--------------------------------------------------------------
*
- * Tk_ConfigureWidget --
+ * Tk_CreateOptionTable --
*
- * Process command-line options and database options to
- * fill in fields of a widget record with resources and
- * other parameters.
+ * Given a template for configuration options, this procedure
+ * creates a table that may be used to look up options efficiently.
*
* Results:
- * A standard Tcl return value. In case of an error,
- * interp->result will hold an error message.
+ * Returns a token to a structure that can be passed to procedures
+ * such as Tk_InitOptions, Tk_SetOptions, and Tk_FreeConfigOptions.
*
* 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.
+ * Storage is allocated.
*
*--------------------------------------------------------------
*/
-int
-Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- Tk_Window tkwin; /* Window containing widget (needed to
- * set up X resources). */
- Tk_ConfigSpec *specs; /* Describes legal options. */
- int argc; /* Number of elements in argv. */
- char **argv; /* Command-line options. */
- char *widgRec; /* Record whose fields are to be
- * modified. Values must be properly
- * initialized. */
- int flags; /* Used to specify additional flags
- * that must be present in config specs
- * for them to be considered. Also,
- * may have TK_CONFIG_ARGV_ONLY set. */
+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. */
{
- register Tk_ConfigSpec *specPtr;
- Tk_Uid value; /* Value of option from database. */
- int needFlags; /* Specs must contain this set of flags
- * or else they are not considered. */
- int hateFlags; /* If a spec contains any bits here, it's
- * not considered. */
-
- needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
- if (Tk_Depth(tkwin) <= 1) {
- hateFlags = TK_CONFIG_COLOR_ONLY;
- } else {
- hateFlags = TK_CONFIG_MONO_ONLY;
+ 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);
}
/*
- * Pass one: scan through all the option specs, replacing strings
- * with Tk_Uids (if this hasn't been done already) and clearing
- * the TK_CONFIG_OPTION_SPECIFIED flags.
+ * See if a table has already been created for this template. If
+ * so, just reuse the existing table.
*/
- for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
- if (!(specPtr->specFlags & INIT) && (specPtr->argvName != NULL)) {
+ 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) {
- specPtr->dbName = Tk_GetUid(specPtr->dbName);
+ optionPtr->dbNameUID = Tk_GetUid(specPtr->dbName);
}
if (specPtr->dbClass != NULL) {
- specPtr->dbClass = Tk_GetUid(specPtr->dbClass);
+ optionPtr->dbClassUID =
+ Tk_GetUid(specPtr->dbClass);
}
if (specPtr->defValue != NULL) {
- specPtr->defValue = Tk_GetUid(specPtr->defValue);
+ 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);
}
}
- specPtr->specFlags = (specPtr->specFlags & ~TK_CONFIG_OPTION_SPECIFIED)
- | INIT;
+ if (((specPtr->type == TK_OPTION_STRING)
+ && (specPtr->internalOffset >= 0))
+ || (specPtr->type == TK_OPTION_COLOR)
+ || (specPtr->type == TK_OPTION_FONT)
+ || (specPtr->type == TK_OPTION_BITMAP)
+ || (specPtr->type == TK_OPTION_BORDER)
+ || (specPtr->type == TK_OPTION_CURSOR)) {
+ optionPtr->flags |= OPTION_NEEDS_FREEING;
+ }
}
+ tablePtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, tablePtr);
/*
- * Pass two: scan through all of the arguments, processing those
- * that match entries in the specs.
+ * 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).
*/
- for ( ; argc > 0; argc -= 2, argv += 2) {
- specPtr = FindConfigSpec(interp, specs, *argv, needFlags, hateFlags);
- if (specPtr == NULL) {
- return TCL_ERROR;
+ 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);
/*
- * Process the entry.
+ * 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).
*/
- if (argc < 2) {
- Tcl_AppendResult(interp, "value for \"", *argv,
- "\" missing", (char *) NULL);
- return TCL_ERROR;
- }
- if (DoConfig(interp, tkwin, specPtr, argv[1], 0, widgRec) != TCL_OK) {
- char msg[100];
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
- sprintf(msg, "\n (processing \"%.40s\" option)",
- specPtr->argvName);
- Tcl_AddErrorInfo(interp, msg);
+int
+Tk_InitOptions(interp, recordPtr, optionTable, tkwin)
+ Tcl_Interp *interp; /* Interpreter for error reporting. NULL
+ * means don't leave an error message. */
+ char *recordPtr; /* Pointer to the record to configure.
+ * Note: the caller should have properly
+ * initialized the record with NULL
+ * pointers for each option value. */
+ Tk_OptionTable optionTable; /* The token which matches the config
+ * specs for the widget in question. */
+ Tk_Window tkwin; /* Certain options types (such as
+ * TK_OPTION_COLOR) need fields out
+ * of the window they are used in to
+ * be able to calculate their values.
+ * Not needed unless one of these
+ * options is in the configSpecs record. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ int count;
+ char *value;
+ Tcl_Obj *valuePtr;
+ enum {
+ OPTION_DATABASE, SYSTEM_DEFAULT, TABLE_DEFAULT
+ } source;
+
+ /*
+ * If this table chains to other tables, handle their initialization
+ * first. That way, if both tables refer to the same field of the
+ * record, the value in the first table will win.
+ */
+
+ if (tablePtr->nextPtr != NULL) {
+ if (Tk_InitOptions(interp, recordPtr,
+ (Tk_OptionTable) tablePtr->nextPtr, tkwin) != TCL_OK) {
return TCL_ERROR;
}
- 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.
+ * Iterate over all of the options in the table, initializing each in
+ * turn.
*/
- 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;
+ 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;
}
- if (((specPtr->specFlags & needFlags) != needFlags)
- || (specPtr->specFlags & hateFlags)) {
- continue;
+ }
+
+ /*
+ * 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;
}
- value = NULL;
- if (specPtr->dbName != NULL) {
- value = Tk_GetOption(tkwin, specPtr->dbName, specPtr->dbClass);
+ }
+
+ /*
+ * 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 (value != NULL) {
- if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
- TCL_OK) {
- char msg[200];
+ }
+
+ if (valuePtr == NULL) {
+ continue;
+ }
+
+ if (DoObjConfig(interp, recordPtr, optionPtr, valuePtr, tkwin,
+ (Tk_SavedOption *) NULL) != TCL_OK) {
+ if (interp != NULL) {
+ 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;
+ 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);
}
- } else {
- value = specPtr->defValue;
- if ((value != NULL) && !(specPtr->specFlags
- & TK_CONFIG_DONT_SET_DEFAULT)) {
- if (DoConfig(interp, tkwin, specPtr, value, 1, widgRec) !=
- TCL_OK) {
- char msg[200];
-
- sprintf(msg,
- "\n (%s \"%.50s\" in widget \"%.50s\")",
- "default value for",
- specPtr->dbName, Tk_PathName(tkwin));
- Tcl_AddErrorInfo(interp, msg);
- return TCL_ERROR;
- }
+ if (tkwin != NULL) {
+ sprintf(msg + strlen(msg) - 1, " in widget \"%.50s\")",
+ Tk_PathName(tkwin));
}
+ Tcl_AddErrorInfo(interp, msg);
}
+ return TCL_ERROR;
}
}
-
return TCL_OK;
}
/*
*--------------------------------------------------------------
*
- * FindConfigSpec --
+ * DoObjConfig --
*
- * Search through a table of configuration specs, looking for
- * one that matches a given argvName.
+ * This procedure applies a new value for a configuration option
+ * to the record being configured.
*
* Results:
- * The return value is a pointer to the matching entry, or NULL
- * if nothing matched. In that case an error message is left
- * in interp->result.
+ * 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:
- * None.
+ * 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 Tk_ConfigSpec *
-FindConfigSpec(interp, specs, argvName, needFlags, hateFlags)
- Tcl_Interp *interp; /* Used for reporting errors. */
- Tk_ConfigSpec *specs; /* Pointer to table of configuration
- * specifications for a widget. */
- char *argvName; /* Name (suitable for use in a "config"
- * command) identifying particular option. */
- int needFlags; /* Flags that must be present in matching
- * entry. */
- int hateFlags; /* Flags that must NOT be present in
- * matching entry. */
+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). */
{
- 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;
+ 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;
}
- if ((specPtr->argvName[1] != c)
- || (strncmp(specPtr->argvName, argvName, length) != 0)) {
- continue;
+ 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;
}
- if (((specPtr->specFlags & needFlags) != needFlags)
- || (specPtr->specFlags & hateFlags)) {
- continue;
+ case TK_OPTION_DOUBLE: {
+ double new;
+
+ if (Tcl_GetDoubleFromObj(interp, valuePtr, &new)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((double *) oldInternalPtr) = *((double *) internalPtr);
+ *((double *) internalPtr) = new;
+ }
+ break;
}
- if (specPtr->argvName[length] == 0) {
- matchPtr = specPtr;
- goto gotMatch;
+ 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;
}
- if (matchPtr != NULL) {
- Tcl_AppendResult(interp, "ambiguous option \"", argvName,
- "\"", (char *) NULL);
- return (Tk_ConfigSpec *) NULL;
+ case TK_OPTION_STRING_TABLE: {
+ int new;
+
+ if (Tcl_GetIndexFromObj(interp, valuePtr,
+ (char **) optionPtr->specPtr->clientData,
+ optionPtr->specPtr->optionName+1, 0, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
}
- matchPtr = specPtr;
- }
+ case TK_OPTION_COLOR: {
+ XColor *newPtr;
- if (matchPtr == NULL) {
- Tcl_AppendResult(interp, "unknown option \"", argvName,
- "\"", (char *) NULL);
- return (Tk_ConfigSpec *) NULL;
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ newPtr = NULL;
+ } else {
+ newPtr = Tk_AllocColorFromObj(interp, tkwin, valuePtr);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((XColor **) oldInternalPtr) = *((XColor **) internalPtr);
+ *((XColor **) internalPtr) = newPtr;
+ }
+ break;
+ }
+ case TK_OPTION_FONT: {
+ Tk_Font new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_AllocFontFromObj(interp, tkwin, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Font *) oldInternalPtr) = *((Tk_Font *) internalPtr);
+ *((Tk_Font *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_BITMAP: {
+ Pixmap new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = None;
+ } else {
+ new = Tk_AllocBitmapFromObj(interp, tkwin, valuePtr);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Pixmap *) oldInternalPtr) = *((Pixmap *) internalPtr);
+ *((Pixmap *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = NULL;
+ } else {
+ new = Tk_Alloc3DBorderFromObj(interp, tkwin, valuePtr);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_3DBorder *) oldInternalPtr) =
+ *((Tk_3DBorder *) internalPtr);
+ *((Tk_3DBorder *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_RELIEF: {
+ int new;
+
+ if (Tk_GetReliefFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ new = None;
+ valuePtr = NULL;
+ } else {
+ new = Tk_AllocCursorFromObj(interp, tkwin, valuePtr);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Cursor *) oldInternalPtr) = *((Tk_Cursor *) internalPtr);
+ *((Tk_Cursor *) internalPtr) = new;
+ }
+ Tk_DefineCursor(tkwin, new);
+ break;
+ }
+ case TK_OPTION_JUSTIFY: {
+ Tk_Justify new;
+
+ if (Tk_GetJustifyFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Justify *) oldInternalPtr)
+ = *((Tk_Justify *) internalPtr);
+ *((Tk_Justify *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_ANCHOR: {
+ Tk_Anchor new;
+
+ if (Tk_GetAnchorFromObj(interp, valuePtr, &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Anchor *) oldInternalPtr)
+ = *((Tk_Anchor *) internalPtr);
+ *((Tk_Anchor *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_PIXELS: {
+ int new;
+
+ if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr,
+ &new) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (internalPtr != NULL) {
+ *((int *) oldInternalPtr) = *((int *) internalPtr);
+ *((int *) internalPtr) = new;
+ }
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window new;
+
+ if (nullOK && ObjectIsEmpty(valuePtr)) {
+ valuePtr = NULL;
+ new = None;
+ } else {
+ if (TkGetWindowFromObj(interp, tkwin, valuePtr, &new)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (internalPtr != NULL) {
+ *((Tk_Window *) oldInternalPtr) = *((Tk_Window *) internalPtr);
+ *((Tk_Window *) internalPtr) = new;
+ }
+ break;
+ }
+ default: {
+ 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;
+ }
}
/*
- * Found a matching entry. If it's a synonym, then find the
- * entry that it's a synonym for.
+ * 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.
*/
- 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;
- }
+ 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 specPtr;
+ return TCL_OK;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * DoConfig --
+ * ObjectIsEmpty --
*
- * This procedure applies a single configuration option
- * to a widget record.
+ * This procedure tests whether the string value of an object is
+ * empty.
*
* Results:
- * A standard Tcl return value.
+ * The return value is 1 if the string value of objPtr has length
+ * zero, and 0 otherwise.
*
* Side effects:
- * WidgRec is modified as indicated by specPtr and value.
- * The old value is recycled, if that is appropriate for
- * the value type.
+ * None.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static int
-DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
- Tcl_Interp *interp; /* Interpreter for error reporting. */
- Tk_Window tkwin; /* Window containing widget (needed to
- * set up X resources). */
- Tk_ConfigSpec *specPtr; /* Specifier to apply. */
- char *value; /* Value to use to fill in widgRec. */
- int valueIsUid; /* Non-zero means value is a Tk_Uid;
- * zero means it's an ordinary string. */
- char *widgRec; /* Record whose fields are to be
- * modified. Values must be properly
- * initialized. */
+ObjectIsEmpty(objPtr)
+ Tcl_Obj *objPtr; /* Object to test. May be NULL. */
{
- char *ptr;
- Tk_Uid uid;
- int nullValue;
+ int length;
- nullValue = 0;
- if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
- nullValue = 1;
+ if (objPtr == NULL) {
+ return 1;
+ }
+ if (objPtr->bytes != NULL) {
+ return (objPtr->length == 0);
}
+ Tcl_GetStringFromObj(objPtr, &length);
+ return (length == 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetOptionFromObj --
+ *
+ * This procedure searches through a chained option table to find
+ * the entry for a particular option name.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry, or NULL
+ * if no matching entry could be found. If NULL is returned and
+ * interp is not NULL than an error message is left in its result.
+ * Note: if the matching entry is a synonym then this procedure
+ * returns a pointer to the synonym entry, *not* the "real" entry
+ * that the synonym refers to.
+ *
+ * Side effects:
+ * Information about the matching entry is cached in the object
+ * containing the name, so that future lookups can proceed more
+ * quickly.
+ *
+ *----------------------------------------------------------------------
+ */
- 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;
+static Option *
+GetOptionFromObj(interp, objPtr, tablePtr)
+ Tcl_Interp *interp; /* Used only for error reporting; if NULL
+ * no message is left after an error. */
+ Tcl_Obj *objPtr; /* Object whose string value is to be
+ * looked up in the option table. */
+ OptionTable *tablePtr; /* Table in which to look up objPtr. */
+{
+ Option *bestPtr, *optionPtr;
+ OptionTable *tablePtr2;
+ char *p1, *p2, *name;
+ int count;
- if (nullValue) {
- new = NULL;
- } else {
- new = (char *) ckalloc((unsigned) (strlen(value) + 1));
- strcpy(new, value);
- }
- old = *((char **) ptr);
- if (old != NULL) {
- ckfree(old);
+ /*
+ * First, check to see if the object already has the answer cached.
+ */
+
+ if (objPtr->typePtr == &optionType) {
+ if (objPtr->internalRep.twoPtrValue.ptr1 == (VOID *) tablePtr) {
+ return (Option *) objPtr->internalRep.twoPtrValue.ptr2;
+ }
+ }
+
+ /*
+ * The answer isn't cached. Search through all of the option tables
+ * in the chain to find the best match. Some tricky aspects:
+ *
+ * 1. We have to accept unique abbreviations.
+ * 2. The same name could appear in different tables in the chain.
+ * If this happens, we use the entry from the first table. We
+ * have to be careful to distinguish this case from an ambiguous
+ * abbreviation.
+ */
+
+ bestPtr = NULL;
+ name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ for (tablePtr2 = tablePtr; tablePtr2 != NULL;
+ tablePtr2 = tablePtr2->nextPtr) {
+ for (optionPtr = tablePtr2->options, count = tablePtr2->numOptions;
+ count > 0; optionPtr++, count--) {
+ for (p1 = name, p2 = optionPtr->specPtr->optionName;
+ *p1 == *p2; p1++, p2++) {
+ if (*p1 == 0) {
+ /*
+ * This is an exact match. We're done.
+ */
+
+ bestPtr = optionPtr;
+ goto done;
}
- *((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 (*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 (nullValue) {
- newPtr = NULL;
+ if (bestPtr == NULL) {
+ bestPtr = optionPtr;
} else {
- uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
- newPtr = Tk_GetColor(interp, tkwin, uid);
- if (newPtr == NULL) {
- return TCL_ERROR;
+ if (strcmp(bestPtr->specPtr->optionName,
+ optionPtr->specPtr->optionName) != 0) {
+ goto error;
}
}
- oldPtr = *((XColor **) ptr);
- if (oldPtr != NULL) {
- Tk_FreeColor(oldPtr);
- }
- *((XColor **) ptr) = newPtr;
- break;
}
- case TK_CONFIG_FONT: {
- Tk_Font new;
+ }
+ }
+ if (bestPtr == NULL) {
+ goto error;
+ }
- 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;
+ done:
+ if ((objPtr->typePtr != NULL)
+ && (objPtr->typePtr->freeIntRepProc != NULL)) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tablePtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) bestPtr;
+ objPtr->typePtr = &optionType;
+ return bestPtr;
+
+ error:
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "unknown option \"", name,
+ "\"", (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetOptionFromAny --
+ *
+ * This procedure is called to convert a Tcl object to option
+ * internal form. However, this doesn't make sense (need to have a
+ * table of options in order to do the conversion) so the
+ * procedure always generates an error.
+ *
+ * Results:
+ * The return value is always TCL_ERROR, and an error message is
+ * left in interp's result if interp isn't NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetOptionFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "can't convert value to option except via GetOptionFromObj API",
+ -1);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetOptions --
+ *
+ * Process one or more name-value pairs for configuration options
+ * and fill in fields of a record with new values.
+ *
+ * Results:
+ * If all goes well then TCL_OK is returned and the old values of
+ * any modified objects are saved in *savePtr, if it isn't NULL (the
+ * caller must eventually call Tk_RestoreSavedOptions or
+ * Tk_FreeSavedOptions to free the contents of *savePtr). In
+ * addition, if maskPtr isn't NULL then *maskPtr is filled in with
+ * the OR of the typeMask bits from all modified options. If an
+ * error occurs then TCL_ERROR is returned and a message
+ * is left in interp's result unless interp is NULL; nothing is
+ * saved in *savePtr or *maskPtr in this case.
+ *
+ * Side effects:
+ * The fields of recordPtr get filled in with object pointers
+ * from objc/objv. Old information in widgRec's fields gets
+ * recycled. Information may be left at *savePtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SetOptions(interp, recordPtr, optionTable, objc, objv, tkwin, savePtr,
+ maskPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting.
+ * If NULL, then no error message is
+ * returned.*/
+ char *recordPtr; /* The record to configure. */
+ Tk_OptionTable optionTable; /* Describes valid options. */
+ int objc; /* The number of elements in objv. */
+ Tcl_Obj *CONST objv[]; /* Contains one or more name-value
+ * pairs. */
+ Tk_Window tkwin; /* Window associated with the thing
+ * being configured; needed for some
+ * options (such as colors). */
+ Tk_SavedOptions *savePtr; /* If non-NULL, the old values of
+ * modified options are saved here
+ * so that they can be restored
+ * after an error. */
+ int *maskPtr; /* It non-NULL, this word is modified
+ * on a successful return to hold the
+ * bit-wise OR of the typeMask fields
+ * of all options that were modified
+ * by this call. Used by the caller
+ * to figure out which options
+ * actually changed. */
+{
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tk_SavedOptions *lastSavePtr, *newSavePtr;
+ int mask;
+
+ if (savePtr != NULL) {
+ savePtr->recordPtr = recordPtr;
+ savePtr->tkwin = tkwin;
+ savePtr->numItems = 0;
+ savePtr->nextPtr = NULL;
+ }
+ lastSavePtr = savePtr;
+
+ /*
+ * Scan through all of the arguments, processing those
+ * that match entries in the option table.
+ */
+
+ mask = 0;
+ for ( ; objc > 0; objc -= 2, objv += 2) {
+ optionPtr = GetOptionFromObj(interp, objv[0], tablePtr);
+ if (optionPtr == NULL) {
+ goto error;
+ }
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
+ }
+
+ if (objc < 2) {
+ if (interp != NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "value for \"", Tcl_GetStringFromObj(*objv, NULL),
+ "\" missing", (char *) NULL);
+ goto error;
}
- case TK_CONFIG_BITMAP: {
- Pixmap new, old;
+ }
+ if ((savePtr != NULL)
+ && (lastSavePtr->numItems >= TK_NUM_SAVED_OPTIONS)) {
+ /*
+ * We've run out of space for saving old option values. Allocate
+ * more space.
+ */
- 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;
- }
+ 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;
}
- old = *((Pixmap *) ptr);
- if (old != None) {
- Tk_FreeBitmap(Tk_Display(tkwin), old);
+ case TK_OPTION_INT: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
}
- *((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;
- }
+ case TK_OPTION_DOUBLE: {
+ *((double *) internalPtr)
+ = *((double *) &savePtr->items[i].internalForm);
+ break;
}
- old = *((Tk_3DBorder *) ptr);
- if (old != NULL) {
- Tk_Free3DBorder(old);
+ case TK_OPTION_STRING: {
+ *((char **) internalPtr)
+ = *((char **) &savePtr->items[i].internalForm);
+ break;
}
- *((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;
+ case TK_OPTION_STRING_TABLE: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
}
- 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;
- }
+ case TK_OPTION_COLOR: {
+ *((XColor **) internalPtr)
+ = *((XColor **) &savePtr->items[i].internalForm);
+ break;
}
- old = *((Tk_Cursor *) ptr);
- if (old != None) {
- Tk_FreeCursor(Tk_Display(tkwin), old);
+ case TK_OPTION_FONT: {
+ *((Tk_Font *) internalPtr)
+ = *((Tk_Font *) &savePtr->items[i].internalForm);
+ break;
}
- *((Tk_Cursor *) ptr) = new;
- if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
- Tk_DefineCursor(tkwin, new);
+ case TK_OPTION_BITMAP: {
+ *((Pixmap *) internalPtr)
+ = *((Pixmap *) &savePtr->items[i].internalForm);
+ break;
}
- 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;
+ case TK_OPTION_BORDER: {
+ *((Tk_3DBorder *) internalPtr)
+ = *((Tk_3DBorder *) &savePtr->items[i].internalForm);
+ break;
}
- 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;
+ case TK_OPTION_RELIEF: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
}
- 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;
+ case TK_OPTION_CURSOR: {
+ *((Tk_Cursor *) internalPtr)
+ = *((Tk_Cursor *) &savePtr->items[i].internalForm);
+ Tk_DefineCursor(savePtr->tkwin,
+ *((Tk_Cursor *) internalPtr));
+ break;
}
- 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;
+ case TK_OPTION_JUSTIFY: {
+ *((Tk_Justify *) internalPtr)
+ = *((Tk_Justify *) &savePtr->items[i].internalForm);
+ break;
}
- break;
- case TK_CONFIG_PIXELS:
- if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
- != TCL_OK) {
- return TCL_ERROR;
+ case TK_OPTION_ANCHOR: {
+ *((Tk_Anchor *) internalPtr)
+ = *((Tk_Anchor *) &savePtr->items[i].internalForm);
+ break;
}
- break;
- case TK_CONFIG_MM:
- if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
- != TCL_OK) {
- return TCL_ERROR;
+ case TK_OPTION_PIXELS: {
+ *((int *) internalPtr)
+ = *((int *) &savePtr->items[i].internalForm);
+ break;
+ }
+ case TK_OPTION_WINDOW: {
+ *((Tk_Window *) internalPtr)
+ = *((Tk_Window *) &savePtr->items[i].internalForm);
+ break;
+ }
+ default: {
+ panic("bad option type in Tk_RestoreSavedOptions");
}
- break;
- case TK_CONFIG_WINDOW: {
- Tk_Window tkwin2;
+ }
+ }
+ }
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
- if (nullValue) {
- tkwin2 = NULL;
- } else {
- tkwin2 = Tk_NameToWindow(interp, value, tkwin);
- if (tkwin2 == NULL) {
- return TCL_ERROR;
- }
+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;
}
- *((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;
+ case TK_OPTION_COLOR:
+ if (internalFormExists) {
+ if (*((XColor **) internalPtr) != NULL) {
+ Tk_FreeColor(*((XColor **) internalPtr));
+ *((XColor **) internalPtr) = NULL;
}
- break;
- default: {
- sprintf(interp->result, "bad config table: unknown type %d",
- specPtr->type);
- return TCL_ERROR;
+ } else if (objPtr != NULL) {
+ Tk_FreeColorFromObj(tkwin, objPtr);
}
- }
- specPtr++;
- } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
- return TCL_OK;
+ break;
+ case TK_OPTION_FONT:
+ if (internalFormExists) {
+ Tk_FreeFont(*((Tk_Font *) internalPtr));
+ *((Tk_Font *) internalPtr) = NULL;
+ } else if (objPtr != NULL) {
+ Tk_FreeFontFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_BITMAP:
+ if (internalFormExists) {
+ if (*((Pixmap *) internalPtr) != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), *((Pixmap *) internalPtr));
+ *((Pixmap *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeBitmapFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_BORDER:
+ if (internalFormExists) {
+ if (*((Tk_3DBorder *) internalPtr) != NULL) {
+ Tk_Free3DBorder(*((Tk_3DBorder *) internalPtr));
+ *((Tk_3DBorder *) internalPtr) = NULL;
+ }
+ } else if (objPtr != NULL) {
+ Tk_Free3DBorderFromObj(tkwin, objPtr);
+ }
+ break;
+ case TK_OPTION_CURSOR:
+ if (internalFormExists) {
+ if (*((Tk_Cursor *) internalPtr) != None) {
+ Tk_FreeCursor(Tk_Display(tkwin),
+ *((Tk_Cursor *) internalPtr));
+ *((Tk_Cursor *) internalPtr) = None;
+ }
+ } else if (objPtr != NULL) {
+ Tk_FreeCursorFromObj(tkwin, objPtr);
+ }
+ break;
+ default:
+ break;
+ }
}
/*
*--------------------------------------------------------------
*
- * Tk_ConfigureInfo --
+ * Tk_GetOptionInfo --
*
- * Return information about the configuration options
- * for a window, and their current values.
+ * Returns a list object containing complete information about
+ * either a single option or all the configuration options in a
+ * table.
*
* Results:
- * Always returns TCL_OK. Interp->result will be modified
- * hold a description of either a single configuration option
- * available for "widgRec" via "specs", or all the configuration
- * options available. In the "all" case, the result will
- * available for "widgRec" via "specs". The result will
- * be a list, each of whose entries describes one option.
- * Each entry will itself be a list containing the option's
- * name for use on command lines, database name, database
- * class, default value, and current value (empty string
- * if none). For options that are synonyms, the list will
- * contain only two values: name and synonym name. If the
- * "name" argument is non-NULL, then the only information
- * returned is that for the named argument (i.e. the corresponding
- * entry in the overall list is returned).
+ * 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.
@@ -581,47 +1638,40 @@ DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
*--------------------------------------------------------------
*/
-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
+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. */
- char *argvName; /* If non-NULL, indicates a single option
- * whose info is to be returned. Otherwise
- * info is returned for all options. */
- int flags; /* Used to specify additional flags
- * that must be present in config specs
- * for them to be considered. */
+ Tk_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. */
{
- 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;
- }
+ 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.
*/
- Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
- if (argvName != NULL) {
- specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
- hateFlags);
- if (specPtr == NULL) {
- return TCL_ERROR;
+ 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;
}
- interp->result = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
- interp->freeProc = TCL_DYNAMIC;
- return TCL_OK;
+ return GetConfigList(recordPtr, optionPtr, tkwin);
}
/*
@@ -629,29 +1679,21 @@ Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
* 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;
+ 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));
}
- if (specPtr->argvName == NULL) {
- continue;
- }
- list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
- Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
- ckfree(list);
- leader = " {";
}
- return TCL_OK;
+ return resultPtr;
}
/*
*--------------------------------------------------------------
*
- * FormatConfigInfo --
+ * GetConfigList --
*
* Create a valid Tcl list holding the configuration information
* for a single configuration option.
@@ -666,67 +1708,78 @@ Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
*--------------------------------------------------------------
*/
-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. */
+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. */
{
- char *argv[6], *result;
- char buffer[200];
- Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;
-
- argv[0] = specPtr->argvName;
- argv[1] = specPtr->dbName;
- argv[2] = specPtr->dbClass;
- argv[3] = specPtr->defValue;
- if (specPtr->type == TK_CONFIG_SYNONYM) {
- return Tcl_Merge(2, argv);
- }
- argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
- &freeProc);
- if (argv[1] == NULL) {
- argv[1] = "";
- }
- if (argv[2] == NULL) {
- argv[2] = "";
- }
- if (argv[3] == NULL) {
- argv[3] = "";
- }
- if (argv[4] == NULL) {
- argv[4] = "";
- }
- result = Tcl_Merge(5, argv);
- if (freeProc != NULL) {
- if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
- ckfree(argv[4]);
+ 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 {
- (*freeProc)(argv[4]);
+ 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 result;
+ return listPtr;
}
/*
*----------------------------------------------------------------------
*
- * FormatConfigValue --
+ * GetObjectForOption --
*
- * This procedure formats the current value of a configuration
- * option.
+ * 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 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.
+ * 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.
@@ -734,146 +1787,130 @@ FormatConfigInfo(interp, tkwin, specPtr, widgRec)
*----------------------------------------------------------------------
*/
-static char *
-FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
- Tcl_Interp *interp; /* Interpreter for use in real conversions. */
- Tk_Window tkwin; /* Window corresponding to widget. */
- Tk_ConfigSpec *specPtr; /* Pointer to information describing option.
- * Must not point to a synonym option. */
- char *widgRec; /* Pointer to record holding current
- * values of info for widget. */
- char *buffer; /* Static buffer to use for small values.
- * Must have at least 200 bytes of storage. */
- Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address
- * of procedure to free the result, or NULL
- * if result is static. */
+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. */
{
- 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";
- }
+ 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_CONFIG_INT:
- sprintf(buffer, "%d", *((int *) ptr));
- result = buffer;
+ }
+ case TK_OPTION_INT: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
break;
- case TK_CONFIG_DOUBLE:
- Tcl_PrintDouble(interp, *((double *) ptr), buffer);
- result = buffer;
+ }
+ case TK_OPTION_DOUBLE: {
+ objPtr = Tcl_NewDoubleObj(*((double *) internalPtr));
break;
- case TK_CONFIG_STRING:
- result = (*(char **) ptr);
- if (result == NULL) {
- result = "";
- }
+ }
+ case TK_OPTION_STRING: {
+ objPtr = Tcl_NewStringObj(*((char **) internalPtr), -1);
break;
- case TK_CONFIG_UID: {
- Tk_Uid uid = *((Tk_Uid *) ptr);
- if (uid != NULL) {
- result = uid;
- }
+ }
+ case TK_OPTION_STRING_TABLE: {
+ objPtr = Tcl_NewStringObj(
+ ((char **) optionPtr->specPtr->clientData)[
+ *((int *) internalPtr)], -1);
break;
}
- case TK_CONFIG_COLOR: {
- XColor *colorPtr = *((XColor **) ptr);
+ case TK_OPTION_COLOR: {
+ XColor *colorPtr = *((XColor **) internalPtr);
if (colorPtr != NULL) {
- result = Tk_NameOfColor(colorPtr);
+ objPtr = Tcl_NewStringObj(Tk_NameOfColor(colorPtr), -1);
}
break;
}
- case TK_CONFIG_FONT: {
- Tk_Font tkfont = *((Tk_Font *) ptr);
+ case TK_OPTION_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) internalPtr);
if (tkfont != NULL) {
- result = Tk_NameOfFont(tkfont);
+ objPtr = Tcl_NewStringObj(Tk_NameOfFont(tkfont), -1);
}
break;
}
- case TK_CONFIG_BITMAP: {
- Pixmap pixmap = *((Pixmap *) ptr);
+ case TK_OPTION_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) internalPtr);
if (pixmap != None) {
- result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
+ objPtr = Tcl_NewStringObj(Tk_NameOfBitmap(Tk_Display(tkwin),
+ pixmap), -1);
}
break;
}
- case TK_CONFIG_BORDER: {
- Tk_3DBorder border = *((Tk_3DBorder *) ptr);
+ case TK_OPTION_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) internalPtr);
if (border != NULL) {
- result = Tk_NameOf3DBorder(border);
+ objPtr = Tcl_NewStringObj(Tk_NameOf3DBorder(border), -1);
}
break;
}
- case TK_CONFIG_RELIEF:
- result = Tk_NameOfRelief(*((int *) ptr));
+ case TK_OPTION_RELIEF: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfRelief(
+ *((int *) internalPtr)), -1);
break;
- case TK_CONFIG_CURSOR:
- case TK_CONFIG_ACTIVE_CURSOR: {
- Tk_Cursor cursor = *((Tk_Cursor *) ptr);
+ }
+ case TK_OPTION_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) internalPtr);
if (cursor != None) {
- result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
+ objPtr = Tcl_NewStringObj(
+ Tk_NameOfCursor(Tk_Display(tkwin), cursor), -1);
}
break;
}
- case TK_CONFIG_JUSTIFY:
- result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
- break;
- case TK_CONFIG_ANCHOR:
- result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
+ case TK_OPTION_JUSTIFY: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfJustify(
+ *((Tk_Justify *) internalPtr)), -1);
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;
+ }
+ case TK_OPTION_ANCHOR: {
+ objPtr = Tcl_NewStringObj(Tk_NameOfAnchor(
+ *((Tk_Anchor *) internalPtr)), -1);
break;
- case TK_CONFIG_MM:
- Tcl_PrintDouble(interp, *((double *) ptr), buffer);
- result = buffer;
+ }
+ case TK_OPTION_PIXELS: {
+ objPtr = Tcl_NewIntObj(*((int *) internalPtr));
break;
- case TK_CONFIG_WINDOW: {
- Tk_Window tkwin;
-
- tkwin = *((Tk_Window *) ptr);
+ }
+ case TK_OPTION_WINDOW: {
+ Tk_Window tkwin = *((Tk_Window *) internalPtr);
if (tkwin != NULL) {
- result = Tk_PathName(tkwin);
+ objPtr = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
}
break;
}
- case TK_CONFIG_CUSTOM:
- result = (*specPtr->customPtr->printProc)(
- specPtr->customPtr->clientData, tkwin, widgRec,
- specPtr->offset, freeProcPtr);
- break;
- default:
- result = "?? unknown type ??";
+ default: {
+ panic("bad option type in GetObjectForOption");
+ }
}
- return result;
+ if (objPtr == NULL) {
+ objPtr = Tcl_NewObj();
+ }
+ return objPtr;
}
/*
*----------------------------------------------------------------------
*
- * Tk_ConfigureValue --
+ * Tk_GetOptionValue --
*
* This procedure returns the current value of a configuration
- * option for a widget.
+ * option.
*
* Results:
- * The return value is a standard Tcl completion code (TCL_OK or
- * TCL_ERROR). Interp->result will be set to hold either the value
- * of the option given by argvName (if TCL_OK is returned) or
- * an error message (if TCL_ERROR is returned).
+ * 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.
@@ -881,110 +1918,115 @@ FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
*----------------------------------------------------------------------
*/
-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
+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. */
- char *argvName; /* Gives the command-line name for the
+ Tk_OptionTable optionTable; /* Describes legal options. */
+ Tcl_Obj *namePtr; /* 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_Window tkwin; /* Window corresponding to recordPtr. */
{
- Tk_ConfigSpec *specPtr;
- int needFlags, hateFlags;
+ OptionTable *tablePtr = (OptionTable *) optionTable;
+ Option *optionPtr;
+ Tcl_Obj *resultPtr;
- needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
- if (Tk_Depth(tkwin) <= 1) {
- hateFlags = TK_CONFIG_COLOR_ONLY;
- } else {
- hateFlags = TK_CONFIG_MONO_ONLY;
+ optionPtr = GetOptionFromObj(interp, namePtr, tablePtr);
+ if (optionPtr == NULL) {
+ return NULL;
}
- specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
- if (specPtr == NULL) {
- return TCL_ERROR;
+ if (optionPtr->specPtr->type == TK_OPTION_SYNONYM) {
+ optionPtr = optionPtr->extra.synonymPtr;
}
- interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
- interp->result, &interp->freeProc);
- return TCL_OK;
+ 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;
}
/*
*----------------------------------------------------------------------
*
- * Tk_FreeOptions --
+ * TkDebugConfig --
*
- * Free up all resources associated with configuration options.
+ * This is a debugging procedure that returns information about
+ * one of the configuration tables that currently exists for an
+ * interpreter.
*
* Results:
- * None.
+ * 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:
- * Any resource in widgRec that is controlled by a configuration
- * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
- * fashion.
+ * None.
*
*----------------------------------------------------------------------
*/
- /* 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. */
+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. */
{
- register Tk_ConfigSpec *specPtr;
- char *ptr;
+ OptionTable *tablePtr = (OptionTable *) table;
+ Tcl_HashTable *hashTablePtr;
+ Tcl_HashEntry *hashEntryPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *objPtr;
- 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;
- }
+ 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/tk/generic/tkConsole.c b/tk/generic/tkConsole.c
index 2294368e1ca..69b113b13ba 100644
--- a/tk/generic/tkConsole.c
+++ b/tk/generic/tkConsole.c
@@ -16,6 +16,8 @@
#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
@@ -27,7 +29,17 @@ typedef struct ConsoleInfo {
Tcl_Interp *interp; /* Interpreter to send console commands. */
} ConsoleInfo;
-static Tcl_Interp *gStdoutInterp = NULL;
+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:
@@ -35,8 +47,6 @@ static Tcl_Interp *gStdoutInterp = NULL;
* The first three will be used in the tk app shells...
*/
-void TkConsoleCreate _ANSI_ARGS_((void));
-int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
int devId, char *buffer, long size));
@@ -75,11 +85,111 @@ static Tcl_ChannelType consoleChannelType = {
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;
+ }
+ 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
/*
*----------------------------------------------------------------------
*
- * TkConsoleCreate --
+ * Tk_InitConsoleChannels --
*
* Create the console channels and install them as the standard
* channels. All I/O will be discarded until TkConsoleInit is
@@ -96,37 +206,95 @@ static Tcl_ChannelType consoleChannelType = {
*/
void
-TkConsoleCreate()
+Tk_InitConsoleChannels(interp)
+ Tcl_Interp *interp;
{
Tcl_Channel consoleChannel;
- consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
- (ClientData) TCL_STDIN, TCL_READABLE);
- if (consoleChannel != NULL) {
- Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
- Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
- }
- Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
- consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
- (ClientData) TCL_STDOUT, TCL_WRITABLE);
- if (consoleChannel != NULL) {
- Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
- Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
+ /*
+ * 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_SetStdChannel(consoleChannel, TCL_STDOUT);
- consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
- (ClientData) TCL_STDERR, TCL_WRITABLE);
- if (consoleChannel != NULL) {
- Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
- Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
+
+ Tcl_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_SetStdChannel(consoleChannel, TCL_STDERR);
+ Tcl_MutexUnlock(&consoleMutex);
}
/*
*----------------------------------------------------------------------
*
- * TkConsoleInit --
+ * Tk_CreateConsoleWindow --
*
* Initialize the console. This code actually creates a new
* application and associated interpreter. This effectivly hides
@@ -142,12 +310,14 @@ TkConsoleCreate()
*/
int
-TkConsoleInit(interp)
+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[] = "source -rsrc {Console}";
#else
@@ -169,7 +339,7 @@ TkConsoleInit(interp)
if (Tk_Init(consoleInterp) != TCL_OK) {
goto error;
}
- gStdoutInterp = interp;
+ tsdPtr->gStdoutInterp = interp;
/*
* Add console commands to the interp
@@ -225,11 +395,15 @@ ConsoleOutput(instanceData, buf, toWrite, errorCode)
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 (gStdoutInterp != NULL) {
- TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);
+ if (tsdPtr->gStdoutInterp != NULL) {
+ TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf,
+ toWrite);
}
return toWrite;
@@ -373,9 +547,10 @@ ConsoleCmd(clientData, interp, argc, argv)
{
ConsoleInfo *info = (ConsoleInfo *) clientData;
char c;
- int length;
+ size_t length;
int result;
Tcl_Interp *consoleInterp;
+ Tcl_DString dString;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -388,23 +563,25 @@ ConsoleCmd(clientData, interp, argc, argv)
result = TCL_OK;
consoleInterp = info->consoleInterp;
Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_DStringInit(&dString);
+
if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
- Tcl_DString dString;
-
- Tcl_DStringInit(&dString);
Tcl_DStringAppend(&dString, "wm title . ", -1);
if (argc == 3) {
Tcl_DStringAppendElement(&dString, argv[2]);
}
Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
- Tcl_DStringFree(&dString);
} else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
- Tcl_Eval(info->consoleInterp, "wm withdraw .");
+ Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
} else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
- Tcl_Eval(info->consoleInterp, "wm deiconify .");
+ 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) {
- Tcl_Eval(info->consoleInterp, argv[2]);
+ 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);
@@ -416,6 +593,7 @@ ConsoleCmd(clientData, interp, argc, argv)
(char *) NULL);
result = TCL_ERROR;
}
+ Tcl_DStringFree(&dString);
Tcl_Release((ClientData) consoleInterp);
return result;
}
@@ -446,7 +624,7 @@ InterpreterCmd(clientData, interp, argc, argv)
{
ConsoleInfo *info = (ConsoleInfo *) clientData;
char c;
- int length;
+ size_t length;
int result;
Tcl_Interp *otherInterp;
@@ -466,6 +644,7 @@ InterpreterCmd(clientData, interp, argc, argv)
} 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],
@@ -494,7 +673,7 @@ InterpreterCmd(clientData, interp, argc, argv)
*----------------------------------------------------------------------
*/
-void
+static void
ConsoleDeleteProc(clientData)
ClientData clientData;
{
@@ -530,9 +709,13 @@ ConsoleEventProc(clientData, eventPtr)
{
ConsoleInfo *info = (ConsoleInfo *) clientData;
Tcl_Interp *consoleInterp;
+ Tcl_DString dString;
if (eventPtr->type == DestroyNotify) {
- consoleInterp = info->consoleInterp;
+
+ Tcl_DStringInit(&dString);
+
+ consoleInterp = info->consoleInterp;
/*
* It is possible that the console interpreter itself has
@@ -545,7 +728,9 @@ ConsoleEventProc(clientData, eventPtr)
return;
}
Tcl_Preserve((ClientData) consoleInterp);
- Tcl_Eval(consoleInterp, "tkConsoleExit");
+ Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
+ Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
+ Tcl_DStringFree(&dString);
Tcl_Release((ClientData) consoleInterp);
}
}
@@ -603,7 +788,7 @@ TkConsolePrint(interp, devId, buffer, size)
Tcl_DStringAppend(&output, buffer, size);
Tcl_DStringInit(&command);
- Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppend(&command, cmd, (int) strlen(cmd));
Tcl_DStringAppendElement(&command, output.string);
consoleInterp = info->consoleInterp;
@@ -614,3 +799,4 @@ TkConsolePrint(interp, devId, buffer, size)
Tcl_DStringFree(&command);
Tcl_DStringFree(&output);
}
+
diff --git a/tk/generic/tkCursor.c b/tk/generic/tkCursor.c
index 31d2d1ca736..6782550b3ba 100644
--- a/tk/generic/tkCursor.c
+++ b/tk/generic/tkCursor.c
@@ -6,7 +6,7 @@
* also avoids round-trips to the X server.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -20,28 +20,11 @@
/*
* A TkCursor structure exists for each cursor that is currently
* active. Each structure is indexed with two hash tables defined
- * below. One of the tables is idTable, and the other is either
- * nameTable or dataTable, also defined below.
+ * 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.
*/
-/*
- * Hash table to map from a textual description of a cursor to the
- * TkCursor record for the cursor, and key structure used in that
- * hash table:
- */
-
-static Tcl_HashTable nameTable;
-typedef struct {
- Tk_Uid name; /* Textual name for desired cursor. */
- Display *display; /* Display for which cursor will be used. */
-} NameKey;
-
-/*
- * Hash table to map from a collection of in-core data about a
- * cursor (bitmap contents, etc.) to a TkCursor structure:
- */
-
-static Tcl_HashTable dataTable;
typedef struct {
char *source; /* Cursor bits. */
char *mask; /* Mask bits. */
@@ -53,24 +36,129 @@ typedef struct {
} DataKey;
/*
- * Hash table that maps from <display + cursor id> to the TkCursor structure
- * for the cursor. This table is used by Tk_FreeCursor.
+ * Forward declarations for procedures defined in this file:
*/
-static Tcl_HashTable idTable;
-typedef struct {
- Display *display; /* Display for which cursor was allocated. */
- Tk_Cursor cursor; /* Cursor identifier. */
-} IdKey;
+static void CursorInit _ANSI_ARGS_((TkDisplay *dispPtr));
+static void DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
+ Tcl_Obj *dupObjPtr));
+static void FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
+static void FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static TkCursor * GetCursor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *name));
+static TkCursor * GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj *objPtr));
+static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr));
-static int initialized = 0; /* 0 means static structures haven't been
- * initialized yet. */
+/*
+ * The following structure defines the implementation of the "cursor" Tcl
+ * object, used for drawing. The color object remembers the hash table
+ * entry associated with a color. The actual allocation and deallocation
+ * of the color should be done by the configuration package when the cursor
+ * option is set.
+ */
+static Tcl_ObjType cursorObjType = {
+ "cursor", /* name */
+ FreeCursorObjProc, /* freeIntRepProc */
+ DupCursorObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
+
/*
- * Forward declarations for procedures defined in this file:
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
*/
-static void CursorInit _ANSI_ARGS_((void));
+Tk_Cursor
+Tk_AllocCursorFromObj(interp, tkwin, objPtr)
+ Tcl_Interp *interp; /* Interp for error results. */
+ Tk_Window tkwin; /* Window in which the cursor will be used.*/
+ Tcl_Obj *objPtr; /* Object describing cursor; see manual
+ * entry for description of legal
+ * syntax of this obj's string rep. */
+{
+ TkCursor *cursorPtr;
+
+ if (objPtr->typePtr != &cursorObjType) {
+ InitCursorObj(objPtr);
+ }
+ cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ /*
+ * If the object currently points to a TkCursor, see if it's the
+ * one we want. If so, increment its reference count and return.
+ */
+
+ if (cursorPtr != NULL) {
+ if (cursorPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkCursor that's
+ * no longer in use. Clear the reference.
+ */
+ FreeCursorObjProc(objPtr);
+ cursorPtr = NULL;
+ } else if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ return cursorPtr->cursor;
+ }
+ }
+
+ /*
+ * The object didn't point to the TkCursor that we wanted. Search
+ * the list of TkCursors with the same name to see if one of the
+ * other TkCursors is the right one.
+ */
+
+ if (cursorPtr != NULL) {
+ TkCursor *firstCursorPtr =
+ (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr);
+ FreeCursorObjProc(objPtr);
+ for (cursorPtr = firstCursorPtr; cursorPtr != NULL;
+ cursorPtr = cursorPtr->nextPtr) {
+ if (Tk_Display(tkwin) == cursorPtr->display) {
+ cursorPtr->resourceRefCount++;
+ cursorPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ return cursorPtr->cursor;
+ }
+ }
+ }
+
+ /*
+ * Still no luck. Call GetCursor to allocate a new TkCursor object.
+ */
+
+ cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr));
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
+ if (cursorPtr == NULL) {
+ return None;
+ } else {
+ cursorPtr->objRefCount++;
+ return cursorPtr->cursor;
+ }
+}
/*
*----------------------------------------------------------------------
@@ -83,7 +171,7 @@ static void CursorInit _ANSI_ARGS_((void));
* Results:
* The return value is the X identifer for the desired cursor,
* unless string couldn't be parsed correctly. In this case,
- * None is returned and an error message is left in interp->result.
+ * 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.
@@ -101,52 +189,104 @@ 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
+ char *string; /* Description of cursor. See manual entry
* for details on legal syntax. */
{
- NameKey nameKey;
- IdKey idKey;
- Tcl_HashEntry *nameHashPtr, *idHashPtr;
+ TkCursor *cursorPtr = GetCursor(interp, tkwin, string);
+ if (cursorPtr == NULL) {
+ return None;
+ }
+ return cursorPtr->cursor;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCursor --
+ *
+ * Given a string describing a cursor, locate (or create if necessary)
+ * a cursor that fits the description. This routine returns the
+ * internal data structure for the cursor, which avoids extra
+ * hash table lookups in Tk_AllocCursorFromObj.
+ *
+ * Results:
+ * The return value is a pointer to the TkCursor for the desired
+ * cursor, unless string couldn't be parsed correctly. In this
+ * case, NULL is returned and an error message is left in the
+ * interp's result. The caller should never modify the cursor that
+ * is returned, and should eventually call Tk_FreeCursor when the
+ * cursor is no longer needed.
+ *
+ * Side effects:
+ * The cursor is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkCursor *
+GetCursor(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ char *string; /* Description of cursor. See manual entry
+ * for details on legal syntax. */
+{
+ Tcl_HashEntry *nameHashPtr;
register TkCursor *cursorPtr;
+ TkCursor *existingCursorPtr = NULL;
int new;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- CursorInit();
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
}
- nameKey.name = string;
- nameKey.display = Tk_Display(tkwin);
- nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new);
+ nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable,
+ string, &new);
if (!new) {
- cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr);
- cursorPtr->refCount++;
- return cursorPtr->cursor;
+ 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) {
- Tcl_DeleteHashEntry(nameHashPtr);
- return None;
+ if (new) {
+ Tcl_DeleteHashEntry(nameHashPtr);
+ }
+ return NULL;
}
/*
* Add information about this cursor to our database.
*/
- cursorPtr->refCount = 1;
- cursorPtr->otherTable = &nameTable;
+ cursorPtr->display = Tk_Display(tkwin);
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->objRefCount = 0;
+ cursorPtr->otherTable = &dispPtr->cursorNameTable;
cursorPtr->hashPtr = nameHashPtr;
- idKey.display = nameKey.display;
- idKey.cursor = cursorPtr->cursor;
- idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
+ cursorPtr->nextPtr = NULL;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &new);
if (!new) {
panic("cursor already registered in Tk_GetCursor");
}
+ cursorPtr->nextPtr = existingCursorPtr;
Tcl_SetHashValue(nameHashPtr, cursorPtr);
- Tcl_SetHashValue(idHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
- return cursorPtr->cursor;
+ return cursorPtr;
}
/*
@@ -160,7 +300,7 @@ Tk_GetCursor(interp, tkwin, string)
* Results:
* The return value is the X identifer for the desired cursor,
* unless it couldn't be created properly. In this case, None is
- * returned and an error message is left in interp->result. The
+ * 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.
@@ -187,14 +327,15 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
Tk_Uid bg; /* Background color for cursor. */
{
DataKey dataKey;
- IdKey idKey;
- Tcl_HashEntry *dataHashPtr, *idHashPtr;
+ Tcl_HashEntry *dataHashPtr;
register TkCursor *cursorPtr;
int new;
XColor fgColor, bgColor;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- CursorInit();
+
+ if (!dispPtr->cursorInit) {
+ CursorInit(dispPtr);
}
dataKey.source = source;
@@ -206,10 +347,11 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
dataKey.fg = fg;
dataKey.bg = bg;
dataKey.display = Tk_Display(tkwin);
- dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &dataKey, &new);
+ dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,
+ (char *) &dataKey, &new);
if (!new) {
cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr);
- cursorPtr->refCount++;
+ cursorPtr->resourceRefCount++;
return cursorPtr->cursor;
}
@@ -236,17 +378,18 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
goto error;
}
- cursorPtr->refCount = 1;
- cursorPtr->otherTable = &dataTable;
+ cursorPtr->resourceRefCount = 1;
+ cursorPtr->otherTable = &dispPtr->cursorDataTable;
cursorPtr->hashPtr = dataHashPtr;
- idKey.display = dataKey.display;
- idKey.cursor = cursorPtr->cursor;
- idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
+ cursorPtr->objRefCount = 0;
+ cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
+ (char *) cursorPtr->cursor, &new);
+
if (!new) {
panic("cursor already registered in Tk_GetCursorFromData");
}
Tcl_SetHashValue(dataHashPtr, cursorPtr);
- Tcl_SetHashValue(idHashPtr, cursorPtr);
+ Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
return cursorPtr->cursor;
error:
@@ -281,27 +424,77 @@ Tk_NameOfCursor(display, cursor)
Tk_Cursor cursor; /* Identifier for cursor whose name is
* wanted. */
{
- IdKey idKey;
Tcl_HashEntry *idHashPtr;
TkCursor *cursorPtr;
- static char string[20];
+ TkDisplay *dispPtr;
- if (!initialized) {
+ dispPtr = TkGetDisplay(display);
+
+ if (!dispPtr->cursorInit) {
printid:
- sprintf(string, "cursor id 0x%x", (unsigned int) cursor);
- return string;
+ sprintf(dispPtr->cursorString, "cursor id 0x%x",
+ (unsigned int) cursor);
+ return dispPtr->cursorString;
}
- idKey.display = display;
- idKey.cursor = cursor;
- idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
if (idHashPtr == NULL) {
goto printid;
}
cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
- if (cursorPtr->otherTable != &nameTable) {
+ if (cursorPtr->otherTable != &dispPtr->cursorNameTable) {
goto printid;
}
- return ((NameKey *) cursorPtr->hashPtr->key.words)->name;
+ 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);
+ }
}
/*
@@ -327,27 +520,258 @@ Tk_FreeCursor(display, cursor)
Display *display; /* Display for which cursor was allocated. */
Tk_Cursor cursor; /* Identifier for cursor to be released. */
{
- IdKey idKey;
Tcl_HashEntry *idHashPtr;
- register TkCursor *cursorPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
- if (!initialized) {
+ if (!dispPtr->cursorInit) {
panic("Tk_FreeCursor called before Tk_GetCursor");
}
- idKey.display = display;
- idKey.cursor = cursor;
- idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor);
if (idHashPtr == NULL) {
panic("Tk_FreeCursor received unknown cursor argument");
}
- cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr);
- cursorPtr->refCount--;
- if (cursorPtr->refCount == 0) {
- Tcl_DeleteHashEntry(cursorPtr->hashPtr);
- Tcl_DeleteHashEntry(idHashPtr);
- TkFreeCursor(cursorPtr);
+ 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 != &cursorObjType) {
+ 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 = &cursorObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
}
/*
@@ -367,11 +791,11 @@ Tk_FreeCursor(display, cursor)
*/
static void
-CursorInit()
+CursorInit(dispPtr)
+ TkDisplay *dispPtr; /* Display used to store thread-specific data. */
{
- initialized = 1;
- Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int));
- Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int));
+ 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
@@ -379,6 +803,68 @@ CursorInit()
* machines.
*/
- Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Tk_Cursor))
- /sizeof(int));
+ /*
+ * 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/tk/generic/tkDecls.h b/tk/generic/tkDecls.h
new file mode 100644
index 00000000000..c60345ad2f7
--- /dev/null
+++ b/tk/generic/tkDecls.h
@@ -0,0 +1,2050 @@
+/*
+ * 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,
+ char * name, char * value, int priority));
+/* 6 */
+EXTERN void Tk_BindEvent _ANSI_ARGS_((
+ Tk_BindingTable bindingTable,
+ XEvent * eventPtr, Tk_Window tkwin,
+ int numObjects, ClientData * objectPtr));
+/* 7 */
+EXTERN void Tk_CanvasDrawableCoords _ANSI_ARGS_((
+ Tk_Canvas canvas, double x, double y,
+ short * drawableXPtr, short * drawableYPtr));
+/* 8 */
+EXTERN void Tk_CanvasEventuallyRedraw _ANSI_ARGS_((
+ Tk_Canvas canvas, int x1, int y1, int x2,
+ int y2));
+/* 9 */
+EXTERN int Tk_CanvasGetCoord _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, char * str,
+ double * doublePtr));
+/* 10 */
+EXTERN Tk_CanvasTextInfo * Tk_CanvasGetTextInfo _ANSI_ARGS_((
+ Tk_Canvas canvas));
+/* 11 */
+EXTERN int Tk_CanvasPsBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, Pixmap bitmap, int x,
+ int y, int width, int height));
+/* 12 */
+EXTERN int Tk_CanvasPsColor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, XColor * colorPtr));
+/* 13 */
+EXTERN int Tk_CanvasPsFont _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, Tk_Font font));
+/* 14 */
+EXTERN void Tk_CanvasPsPath _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, double * coordPtr,
+ int numPoints));
+/* 15 */
+EXTERN int Tk_CanvasPsStipple _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Canvas canvas, Pixmap bitmap));
+/* 16 */
+EXTERN double Tk_CanvasPsY _ANSI_ARGS_((Tk_Canvas canvas, double y));
+/* 17 */
+EXTERN void Tk_CanvasSetStippleOrigin _ANSI_ARGS_((
+ Tk_Canvas canvas, GC gc));
+/* 18 */
+EXTERN int Tk_CanvasTagsParseProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp * interp,
+ Tk_Window tkwin, char * value,
+ char * widgRec, int offset));
+/* 19 */
+EXTERN char * Tk_CanvasTagsPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char * widgRec, int offset,
+ Tcl_FreeProc ** freeProcPtr));
+/* 20 */
+EXTERN Tk_Window Tk_CanvasTkwin _ANSI_ARGS_((Tk_Canvas canvas));
+/* 21 */
+EXTERN void Tk_CanvasWindowCoords _ANSI_ARGS_((Tk_Canvas canvas,
+ double x, double y, short * screenXPtr,
+ short * screenYPtr));
+/* 22 */
+EXTERN void Tk_ChangeWindowAttributes _ANSI_ARGS_((
+ Tk_Window tkwin, unsigned long valueMask,
+ XSetWindowAttributes * attsPtr));
+/* 23 */
+EXTERN int Tk_CharBbox _ANSI_ARGS_((Tk_TextLayout layout,
+ int index, int * xPtr, int * yPtr,
+ int * widthPtr, int * heightPtr));
+/* 24 */
+EXTERN void Tk_ClearSelection _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection));
+/* 25 */
+EXTERN int Tk_ClipboardAppend _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Atom target, Atom format,
+ char* buffer));
+/* 26 */
+EXTERN int Tk_ClipboardClear _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin));
+/* 27 */
+EXTERN int Tk_ConfigureInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec * specs,
+ char * widgRec, char * argvName, int flags));
+/* 28 */
+EXTERN int Tk_ConfigureValue _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec * specs,
+ char * widgRec, char * argvName, int flags));
+/* 29 */
+EXTERN int Tk_ConfigureWidget _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec * specs,
+ int argc, char ** argv, char * widgRec,
+ int flags));
+/* 30 */
+EXTERN void Tk_ConfigureWindow _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned int valueMask,
+ XWindowChanges * valuePtr));
+/* 31 */
+EXTERN Tk_TextLayout Tk_ComputeTextLayout _ANSI_ARGS_((Tk_Font font,
+ CONST char * str, int numChars,
+ int wrapLength, Tk_Justify justify,
+ int flags, int * widthPtr, int * heightPtr));
+/* 32 */
+EXTERN Tk_Window Tk_CoordsToWindow _ANSI_ARGS_((int rootX, int rootY,
+ Tk_Window tkwin));
+/* 33 */
+EXTERN unsigned long Tk_CreateBinding _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, char * eventStr,
+ char * command, int append));
+/* 34 */
+EXTERN Tk_BindingTable Tk_CreateBindingTable _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 35 */
+EXTERN Tk_ErrorHandler Tk_CreateErrorHandler _ANSI_ARGS_((Display * display,
+ int errNum, int request, int minorCode,
+ Tk_ErrorProc * errorProc,
+ ClientData clientData));
+/* 36 */
+EXTERN void Tk_CreateEventHandler _ANSI_ARGS_((Tk_Window token,
+ unsigned long mask, Tk_EventProc * proc,
+ ClientData clientData));
+/* 37 */
+EXTERN void Tk_CreateGenericHandler _ANSI_ARGS_((
+ Tk_GenericProc * proc, ClientData clientData));
+/* 38 */
+EXTERN void Tk_CreateImageType _ANSI_ARGS_((
+ Tk_ImageType * typePtr));
+/* 39 */
+EXTERN void Tk_CreateItemType _ANSI_ARGS_((Tk_ItemType * typePtr));
+/* 40 */
+EXTERN void Tk_CreatePhotoImageFormat _ANSI_ARGS_((
+ Tk_PhotoImageFormat * formatPtr));
+/* 41 */
+EXTERN void Tk_CreateSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Atom target,
+ Tk_SelectionProc * proc,
+ ClientData clientData, Atom format));
+/* 42 */
+EXTERN Tk_Window Tk_CreateWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window parent, char * name,
+ char * screenName));
+/* 43 */
+EXTERN Tk_Window Tk_CreateWindowFromPath _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ char * pathName, char * screenName));
+/* 44 */
+EXTERN int Tk_DefineBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name, char * source, int width,
+ int height));
+/* 45 */
+EXTERN void Tk_DefineCursor _ANSI_ARGS_((Tk_Window window,
+ Tk_Cursor cursor));
+/* 46 */
+EXTERN void Tk_DeleteAllBindings _ANSI_ARGS_((
+ Tk_BindingTable bindingTable,
+ ClientData object));
+/* 47 */
+EXTERN int Tk_DeleteBinding _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, char * eventStr));
+/* 48 */
+EXTERN void Tk_DeleteBindingTable _ANSI_ARGS_((
+ Tk_BindingTable bindingTable));
+/* 49 */
+EXTERN void Tk_DeleteErrorHandler _ANSI_ARGS_((
+ Tk_ErrorHandler handler));
+/* 50 */
+EXTERN void Tk_DeleteEventHandler _ANSI_ARGS_((Tk_Window token,
+ unsigned long mask, Tk_EventProc * proc,
+ ClientData clientData));
+/* 51 */
+EXTERN void Tk_DeleteGenericHandler _ANSI_ARGS_((
+ Tk_GenericProc * proc, ClientData clientData));
+/* 52 */
+EXTERN void Tk_DeleteImage _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name));
+/* 53 */
+EXTERN void Tk_DeleteSelHandler _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Atom target));
+/* 54 */
+EXTERN void Tk_DestroyWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 55 */
+EXTERN char * Tk_DisplayName _ANSI_ARGS_((Tk_Window tkwin));
+/* 56 */
+EXTERN int Tk_DistanceToTextLayout _ANSI_ARGS_((
+ Tk_TextLayout layout, int x, int y));
+/* 57 */
+EXTERN void Tk_Draw3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint * pointPtr, int numPoints,
+ int borderWidth, int leftRelief));
+/* 58 */
+EXTERN void Tk_Draw3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height,
+ int borderWidth, int relief));
+/* 59 */
+EXTERN void Tk_DrawChars _ANSI_ARGS_((Display * display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char * source, int numBytes, int x,
+ int y));
+/* 60 */
+EXTERN void Tk_DrawFocusHighlight _ANSI_ARGS_((Tk_Window tkwin,
+ GC gc, int width, Drawable drawable));
+/* 61 */
+EXTERN void Tk_DrawTextLayout _ANSI_ARGS_((Display * display,
+ Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int firstChar, int lastChar));
+/* 62 */
+EXTERN void Tk_Fill3DPolygon _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border,
+ XPoint * pointPtr, int numPoints,
+ int borderWidth, int leftRelief));
+/* 63 */
+EXTERN void Tk_Fill3DRectangle _ANSI_ARGS_((Tk_Window tkwin,
+ Drawable drawable, Tk_3DBorder border, int x,
+ int y, int width, int height,
+ int borderWidth, int relief));
+/* 64 */
+EXTERN Tk_PhotoHandle Tk_FindPhoto _ANSI_ARGS_((Tcl_Interp * interp,
+ char * imageName));
+/* 65 */
+EXTERN Font Tk_FontId _ANSI_ARGS_((Tk_Font font));
+/* 66 */
+EXTERN void Tk_Free3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+/* 67 */
+EXTERN void Tk_FreeBitmap _ANSI_ARGS_((Display * display,
+ Pixmap bitmap));
+/* 68 */
+EXTERN void Tk_FreeColor _ANSI_ARGS_((XColor * colorPtr));
+/* 69 */
+EXTERN void Tk_FreeColormap _ANSI_ARGS_((Display * display,
+ Colormap colormap));
+/* 70 */
+EXTERN void Tk_FreeCursor _ANSI_ARGS_((Display * display,
+ Tk_Cursor cursor));
+/* 71 */
+EXTERN void Tk_FreeFont _ANSI_ARGS_((Tk_Font f));
+/* 72 */
+EXTERN void Tk_FreeGC _ANSI_ARGS_((Display * display, GC gc));
+/* 73 */
+EXTERN void Tk_FreeImage _ANSI_ARGS_((Tk_Image image));
+/* 74 */
+EXTERN void Tk_FreeOptions _ANSI_ARGS_((Tk_ConfigSpec * specs,
+ char * widgRec, Display * display,
+ int needFlags));
+/* 75 */
+EXTERN void Tk_FreePixmap _ANSI_ARGS_((Display * display,
+ Pixmap pixmap));
+/* 76 */
+EXTERN void Tk_FreeTextLayout _ANSI_ARGS_((
+ Tk_TextLayout textLayout));
+/* 77 */
+EXTERN void Tk_FreeXId _ANSI_ARGS_((Display * display, XID xid));
+/* 78 */
+EXTERN GC Tk_GCForColor _ANSI_ARGS_((XColor * colorPtr,
+ Drawable drawable));
+/* 79 */
+EXTERN void Tk_GeometryRequest _ANSI_ARGS_((Tk_Window tkwin,
+ int reqWidth, int reqHeight));
+/* 80 */
+EXTERN Tk_3DBorder Tk_Get3DBorder _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid colorName));
+/* 81 */
+EXTERN void Tk_GetAllBindings _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object));
+/* 82 */
+EXTERN int Tk_GetAnchor _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, Tk_Anchor * anchorPtr));
+/* 83 */
+EXTERN char * Tk_GetAtomName _ANSI_ARGS_((Tk_Window tkwin,
+ Atom atom));
+/* 84 */
+EXTERN char * Tk_GetBinding _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_BindingTable bindingTable,
+ ClientData object, char * eventStr));
+/* 85 */
+EXTERN Pixmap Tk_GetBitmap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str));
+/* 86 */
+EXTERN Pixmap Tk_GetBitmapFromData _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ char * source, int width, int height));
+/* 87 */
+EXTERN int Tk_GetCapStyle _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int * capPtr));
+/* 88 */
+EXTERN XColor * Tk_GetColor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid name));
+/* 89 */
+EXTERN XColor * Tk_GetColorByValue _ANSI_ARGS_((Tk_Window tkwin,
+ XColor * colorPtr));
+/* 90 */
+EXTERN Colormap Tk_GetColormap _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * str));
+/* 91 */
+EXTERN Tk_Cursor Tk_GetCursor _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid str));
+/* 92 */
+EXTERN Tk_Cursor Tk_GetCursorFromData _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ char * source, char * mask, int width,
+ int height, int xHot, int yHot, Tk_Uid fg,
+ Tk_Uid bg));
+/* 93 */
+EXTERN Tk_Font Tk_GetFont _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, CONST char * str));
+/* 94 */
+EXTERN Tk_Font Tk_GetFontFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 95 */
+EXTERN void Tk_GetFontMetrics _ANSI_ARGS_((Tk_Font font,
+ Tk_FontMetrics * fmPtr));
+/* 96 */
+EXTERN GC Tk_GetGC _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long valueMask,
+ XGCValues * valuePtr));
+/* 97 */
+EXTERN Tk_Image Tk_GetImage _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * name,
+ Tk_ImageChangedProc * changeProc,
+ ClientData clientData));
+/* 98 */
+EXTERN ClientData Tk_GetImageMasterData _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name,
+ Tk_ImageType ** typePtrPtr));
+/* 99 */
+EXTERN Tk_ItemType * Tk_GetItemTypes _ANSI_ARGS_((void));
+/* 100 */
+EXTERN int Tk_GetJoinStyle _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, int * joinPtr));
+/* 101 */
+EXTERN int Tk_GetJustify _ANSI_ARGS_((Tcl_Interp * interp,
+ char * str, Tk_Justify * justifyPtr));
+/* 102 */
+EXTERN int Tk_GetNumMainWindows _ANSI_ARGS_((void));
+/* 103 */
+EXTERN Tk_Uid Tk_GetOption _ANSI_ARGS_((Tk_Window tkwin,
+ char * name, char * className));
+/* 104 */
+EXTERN int Tk_GetPixels _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * str, int * intPtr));
+/* 105 */
+EXTERN Pixmap Tk_GetPixmap _ANSI_ARGS_((Display * display,
+ Drawable d, int width, int height, int depth));
+/* 106 */
+EXTERN int Tk_GetRelief _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, int * reliefPtr));
+/* 107 */
+EXTERN void Tk_GetRootCoords _ANSI_ARGS_((Tk_Window tkwin,
+ int * xPtr, int * yPtr));
+/* 108 */
+EXTERN int Tk_GetScrollInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ int argc, char ** argv, double * dblPtr,
+ int * intPtr));
+/* 109 */
+EXTERN int Tk_GetScreenMM _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * str,
+ double * doublePtr));
+/* 110 */
+EXTERN int Tk_GetSelection _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Atom selection, Atom target,
+ Tk_GetSelProc * proc, ClientData clientData));
+/* 111 */
+EXTERN Tk_Uid Tk_GetUid _ANSI_ARGS_((CONST char * str));
+/* 112 */
+EXTERN Visual * Tk_GetVisual _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * str, int * depthPtr,
+ Colormap * colormapPtr));
+/* 113 */
+EXTERN void Tk_GetVRootGeometry _ANSI_ARGS_((Tk_Window tkwin,
+ int * xPtr, int * yPtr, int * widthPtr,
+ int * heightPtr));
+/* 114 */
+EXTERN int Tk_Grab _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, int grabGlobal));
+/* 115 */
+EXTERN void Tk_HandleEvent _ANSI_ARGS_((XEvent * eventPtr));
+/* 116 */
+EXTERN Tk_Window Tk_IdToWindow _ANSI_ARGS_((Display * display,
+ Window window));
+/* 117 */
+EXTERN void Tk_ImageChanged _ANSI_ARGS_((Tk_ImageMaster master,
+ int x, int y, int width, int height,
+ int imageWidth, int imageHeight));
+/* 118 */
+EXTERN int Tk_Init _ANSI_ARGS_((Tcl_Interp * interp));
+/* 119 */
+EXTERN Atom Tk_InternAtom _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 120 */
+EXTERN int Tk_IntersectTextLayout _ANSI_ARGS_((
+ Tk_TextLayout layout, int x, int y,
+ int width, int height));
+/* 121 */
+EXTERN void Tk_MaintainGeometry _ANSI_ARGS_((Tk_Window slave,
+ Tk_Window master, int x, int y, int width,
+ int height));
+/* 122 */
+EXTERN Tk_Window Tk_MainWindow _ANSI_ARGS_((Tcl_Interp * interp));
+/* 123 */
+EXTERN void Tk_MakeWindowExist _ANSI_ARGS_((Tk_Window tkwin));
+/* 124 */
+EXTERN void Tk_ManageGeometry _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_GeomMgr * mgrPtr, ClientData clientData));
+/* 125 */
+EXTERN void Tk_MapWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 126 */
+EXTERN int Tk_MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
+ CONST char * source, int numBytes,
+ int maxPixels, int flags, int * lengthPtr));
+/* 127 */
+EXTERN void Tk_MoveResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height));
+/* 128 */
+EXTERN void Tk_MoveWindow _ANSI_ARGS_((Tk_Window tkwin, int x,
+ int y));
+/* 129 */
+EXTERN void Tk_MoveToplevelWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y));
+/* 130 */
+EXTERN char * Tk_NameOf3DBorder _ANSI_ARGS_((Tk_3DBorder border));
+/* 131 */
+EXTERN char * Tk_NameOfAnchor _ANSI_ARGS_((Tk_Anchor anchor));
+/* 132 */
+EXTERN char * Tk_NameOfBitmap _ANSI_ARGS_((Display * display,
+ Pixmap bitmap));
+/* 133 */
+EXTERN char * Tk_NameOfCapStyle _ANSI_ARGS_((int cap));
+/* 134 */
+EXTERN char * Tk_NameOfColor _ANSI_ARGS_((XColor * colorPtr));
+/* 135 */
+EXTERN char * Tk_NameOfCursor _ANSI_ARGS_((Display * display,
+ Tk_Cursor cursor));
+/* 136 */
+EXTERN char * Tk_NameOfFont _ANSI_ARGS_((Tk_Font font));
+/* 137 */
+EXTERN char * Tk_NameOfImage _ANSI_ARGS_((
+ Tk_ImageMaster imageMaster));
+/* 138 */
+EXTERN char * Tk_NameOfJoinStyle _ANSI_ARGS_((int join));
+/* 139 */
+EXTERN char * Tk_NameOfJustify _ANSI_ARGS_((Tk_Justify justify));
+/* 140 */
+EXTERN char * Tk_NameOfRelief _ANSI_ARGS_((int relief));
+/* 141 */
+EXTERN Tk_Window Tk_NameToWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ char * pathName, Tk_Window tkwin));
+/* 142 */
+EXTERN void Tk_OwnSelection _ANSI_ARGS_((Tk_Window tkwin,
+ Atom selection, Tk_LostSelProc * proc,
+ ClientData clientData));
+/* 143 */
+EXTERN int Tk_ParseArgv _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, int * argcPtr, char ** argv,
+ Tk_ArgvInfo * argTable, int flags));
+/* 144 */
+EXTERN void Tk_PhotoPutBlock _ANSI_ARGS_((Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr, int x, int y,
+ int width, int height));
+/* 145 */
+EXTERN void Tk_PhotoPutZoomedBlock _ANSI_ARGS_((
+ Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr, int x, int y,
+ int width, int height, int zoomX, int zoomY,
+ int subsampleX, int subsampleY));
+/* 146 */
+EXTERN int Tk_PhotoGetImage _ANSI_ARGS_((Tk_PhotoHandle handle,
+ Tk_PhotoImageBlock * blockPtr));
+/* 147 */
+EXTERN void Tk_PhotoBlank _ANSI_ARGS_((Tk_PhotoHandle handle));
+/* 148 */
+EXTERN void Tk_PhotoExpand _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int width, int height));
+/* 149 */
+EXTERN void Tk_PhotoGetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int * widthPtr, int * heightPtr));
+/* 150 */
+EXTERN void Tk_PhotoSetSize _ANSI_ARGS_((Tk_PhotoHandle handle,
+ int width, int height));
+/* 151 */
+EXTERN int Tk_PointToChar _ANSI_ARGS_((Tk_TextLayout layout,
+ int x, int y));
+/* 152 */
+EXTERN int Tk_PostscriptFontName _ANSI_ARGS_((Tk_Font tkfont,
+ Tcl_DString * dsPtr));
+/* 153 */
+EXTERN void Tk_PreserveColormap _ANSI_ARGS_((Display * display,
+ Colormap colormap));
+/* 154 */
+EXTERN void Tk_QueueWindowEvent _ANSI_ARGS_((XEvent * eventPtr,
+ Tcl_QueuePosition position));
+/* 155 */
+EXTERN void Tk_RedrawImage _ANSI_ARGS_((Tk_Image image,
+ int imageX, int imageY, int width,
+ int height, Drawable drawable, int drawableX,
+ int drawableY));
+/* 156 */
+EXTERN void Tk_ResizeWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int width, int height));
+/* 157 */
+EXTERN int Tk_RestackWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int aboveBelow, Tk_Window other));
+/* 158 */
+EXTERN Tk_RestrictProc * Tk_RestrictEvents _ANSI_ARGS_((
+ Tk_RestrictProc * proc, ClientData arg,
+ ClientData * prevArgPtr));
+/* 159 */
+EXTERN int Tk_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
+/* 160 */
+EXTERN char * Tk_SetAppName _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 161 */
+EXTERN void Tk_SetBackgroundFromBorder _ANSI_ARGS_((
+ Tk_Window tkwin, Tk_3DBorder border));
+/* 162 */
+EXTERN void Tk_SetClass _ANSI_ARGS_((Tk_Window tkwin,
+ char * className));
+/* 163 */
+EXTERN void Tk_SetGrid _ANSI_ARGS_((Tk_Window tkwin,
+ int reqWidth, int reqHeight, int gridWidth,
+ int gridHeight));
+/* 164 */
+EXTERN void Tk_SetInternalBorder _ANSI_ARGS_((Tk_Window tkwin,
+ int width));
+/* 165 */
+EXTERN void Tk_SetWindowBackground _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long pixel));
+/* 166 */
+EXTERN void Tk_SetWindowBackgroundPixmap _ANSI_ARGS_((
+ Tk_Window tkwin, Pixmap pixmap));
+/* 167 */
+EXTERN void Tk_SetWindowBorder _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long pixel));
+/* 168 */
+EXTERN void Tk_SetWindowBorderWidth _ANSI_ARGS_((Tk_Window tkwin,
+ int width));
+/* 169 */
+EXTERN void Tk_SetWindowBorderPixmap _ANSI_ARGS_((
+ Tk_Window tkwin, Pixmap pixmap));
+/* 170 */
+EXTERN void Tk_SetWindowColormap _ANSI_ARGS_((Tk_Window tkwin,
+ Colormap colormap));
+/* 171 */
+EXTERN int Tk_SetWindowVisual _ANSI_ARGS_((Tk_Window tkwin,
+ Visual * visual, int depth,
+ Colormap colormap));
+/* 172 */
+EXTERN void Tk_SizeOfBitmap _ANSI_ARGS_((Display * display,
+ Pixmap bitmap, int * widthPtr,
+ int * heightPtr));
+/* 173 */
+EXTERN void Tk_SizeOfImage _ANSI_ARGS_((Tk_Image image,
+ int * widthPtr, int * heightPtr));
+/* 174 */
+EXTERN int Tk_StrictMotif _ANSI_ARGS_((Tk_Window tkwin));
+/* 175 */
+EXTERN void Tk_TextLayoutToPostscript _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_TextLayout layout));
+/* 176 */
+EXTERN int Tk_TextWidth _ANSI_ARGS_((Tk_Font font,
+ CONST char * str, int numBytes));
+/* 177 */
+EXTERN void Tk_UndefineCursor _ANSI_ARGS_((Tk_Window window));
+/* 178 */
+EXTERN void Tk_UnderlineChars _ANSI_ARGS_((Display * display,
+ Drawable drawable, GC gc, Tk_Font tkfont,
+ CONST char * source, int x, int y,
+ int firstByte, int lastByte));
+/* 179 */
+EXTERN void Tk_UnderlineTextLayout _ANSI_ARGS_((
+ Display * display, Drawable drawable, GC gc,
+ Tk_TextLayout layout, int x, int y,
+ int underline));
+/* 180 */
+EXTERN void Tk_Ungrab _ANSI_ARGS_((Tk_Window tkwin));
+/* 181 */
+EXTERN void Tk_UnmaintainGeometry _ANSI_ARGS_((Tk_Window slave,
+ Tk_Window master));
+/* 182 */
+EXTERN void Tk_UnmapWindow _ANSI_ARGS_((Tk_Window tkwin));
+/* 183 */
+EXTERN void Tk_UnsetGrid _ANSI_ARGS_((Tk_Window tkwin));
+/* 184 */
+EXTERN void Tk_UpdatePointer _ANSI_ARGS_((Tk_Window tkwin, int x,
+ int y, int state));
+/* 185 */
+EXTERN Pixmap Tk_AllocBitmapFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 186 */
+EXTERN Tk_3DBorder Tk_Alloc3DBorderFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 187 */
+EXTERN XColor * Tk_AllocColorFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 188 */
+EXTERN Tk_Cursor Tk_AllocCursorFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 189 */
+EXTERN Tk_Font Tk_AllocFontFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr));
+/* 190 */
+EXTERN Tk_OptionTable Tk_CreateOptionTable _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ CONST Tk_OptionSpec * templatePtr));
+/* 191 */
+EXTERN void Tk_DeleteOptionTable _ANSI_ARGS_((
+ Tk_OptionTable optionTable));
+/* 192 */
+EXTERN void Tk_Free3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 193 */
+EXTERN void Tk_FreeBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 194 */
+EXTERN void Tk_FreeColorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 195 */
+EXTERN void Tk_FreeConfigOptions _ANSI_ARGS_((char * recordPtr,
+ Tk_OptionTable optionToken, Tk_Window tkwin));
+/* 196 */
+EXTERN void Tk_FreeSavedOptions _ANSI_ARGS_((
+ Tk_SavedOptions * savePtr));
+/* 197 */
+EXTERN void Tk_FreeCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 198 */
+EXTERN void Tk_FreeFontFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 199 */
+EXTERN Tk_3DBorder Tk_Get3DBorderFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 200 */
+EXTERN int Tk_GetAnchorFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, Tk_Anchor * anchorPtr));
+/* 201 */
+EXTERN Pixmap Tk_GetBitmapFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 202 */
+EXTERN XColor * Tk_GetColorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 203 */
+EXTERN Tk_Cursor Tk_GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin,
+ Tcl_Obj * objPtr));
+/* 204 */
+EXTERN Tcl_Obj * Tk_GetOptionInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj * namePtr, Tk_Window tkwin));
+/* 205 */
+EXTERN Tcl_Obj * Tk_GetOptionValue _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionTable,
+ Tcl_Obj * namePtr, Tk_Window tkwin));
+/* 206 */
+EXTERN int Tk_GetJustifyFromObj _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Obj * objPtr,
+ Tk_Justify * justifyPtr));
+/* 207 */
+EXTERN int Tk_GetMMFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr,
+ double * doublePtr));
+/* 208 */
+EXTERN int Tk_GetPixelsFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr,
+ int * intPtr));
+/* 209 */
+EXTERN int Tk_GetReliefFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * objPtr, int * resultPtr));
+/* 210 */
+EXTERN int Tk_GetScrollInfoObj _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[],
+ double * dblPtr, int * intPtr));
+/* 211 */
+EXTERN int Tk_InitOptions _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionToken,
+ Tk_Window tkwin));
+/* 212 */
+EXTERN void Tk_MainEx _ANSI_ARGS_((int argc, char ** argv,
+ Tcl_AppInitProc * appInitProc,
+ Tcl_Interp * interp));
+/* 213 */
+EXTERN void Tk_RestoreSavedOptions _ANSI_ARGS_((
+ Tk_SavedOptions * savePtr));
+/* 214 */
+EXTERN int Tk_SetOptions _ANSI_ARGS_((Tcl_Interp * interp,
+ char * recordPtr, Tk_OptionTable optionTable,
+ int objc, Tcl_Obj *CONST objv[],
+ Tk_Window tkwin, Tk_SavedOptions * savePtr,
+ int * maskPtr));
+/* 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));
+
+typedef struct TkStubHooks {
+ struct TkPlatStubs *tkPlatStubs;
+ struct TkIntStubs *tkIntStubs;
+ struct TkIntPlatStubs *tkIntPlatStubs;
+ struct TkIntXlibStubs *tkIntXlibStubs;
+} TkStubHooks;
+
+typedef struct TkStubs {
+ int magic;
+ struct TkStubHooks *hooks;
+
+ void (*tk_MainLoop) _ANSI_ARGS_((void)); /* 0 */
+ XColor * (*tk_3DBorderColor) _ANSI_ARGS_((Tk_3DBorder border)); /* 1 */
+ GC (*tk_3DBorderGC) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border, int which)); /* 2 */
+ void (*tk_3DHorizontalBevel) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftIn, int rightIn, int topBevel, int relief)); /* 3 */
+ void (*tk_3DVerticalBevel) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int leftBevel, int relief)); /* 4 */
+ void (*tk_AddOption) _ANSI_ARGS_((Tk_Window tkwin, char * name, char * value, int priority)); /* 5 */
+ void (*tk_BindEvent) _ANSI_ARGS_((Tk_BindingTable bindingTable, XEvent * eventPtr, Tk_Window tkwin, int numObjects, ClientData * objectPtr)); /* 6 */
+ void (*tk_CanvasDrawableCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * drawableXPtr, short * drawableYPtr)); /* 7 */
+ void (*tk_CanvasEventuallyRedraw) _ANSI_ARGS_((Tk_Canvas canvas, int x1, int y1, int x2, int y2)); /* 8 */
+ int (*tk_CanvasGetCoord) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, char * str, double * doublePtr)); /* 9 */
+ Tk_CanvasTextInfo * (*tk_CanvasGetTextInfo) _ANSI_ARGS_((Tk_Canvas canvas)); /* 10 */
+ int (*tk_CanvasPsBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap, int x, int y, int width, int height)); /* 11 */
+ int (*tk_CanvasPsColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, XColor * colorPtr)); /* 12 */
+ int (*tk_CanvasPsFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Tk_Font font)); /* 13 */
+ void (*tk_CanvasPsPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * coordPtr, int numPoints)); /* 14 */
+ int (*tk_CanvasPsStipple) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, Pixmap bitmap)); /* 15 */
+ double (*tk_CanvasPsY) _ANSI_ARGS_((Tk_Canvas canvas, double y)); /* 16 */
+ void (*tk_CanvasSetStippleOrigin) _ANSI_ARGS_((Tk_Canvas canvas, GC gc)); /* 17 */
+ int (*tk_CanvasTagsParseProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, Tk_Window tkwin, char * value, char * widgRec, int offset)); /* 18 */
+ char * (*tk_CanvasTagsPrintProc) _ANSI_ARGS_((ClientData clientData, Tk_Window tkwin, char * widgRec, int offset, Tcl_FreeProc ** freeProcPtr)); /* 19 */
+ Tk_Window (*tk_CanvasTkwin) _ANSI_ARGS_((Tk_Canvas canvas)); /* 20 */
+ void (*tk_CanvasWindowCoords) _ANSI_ARGS_((Tk_Canvas canvas, double x, double y, short * screenXPtr, short * screenYPtr)); /* 21 */
+ void (*tk_ChangeWindowAttributes) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XSetWindowAttributes * attsPtr)); /* 22 */
+ int (*tk_CharBbox) _ANSI_ARGS_((Tk_TextLayout layout, int index, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 23 */
+ void (*tk_ClearSelection) _ANSI_ARGS_((Tk_Window tkwin, Atom selection)); /* 24 */
+ int (*tk_ClipboardAppend) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom target, Atom format, char* buffer)); /* 25 */
+ int (*tk_ClipboardClear) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 26 */
+ int (*tk_ConfigureInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, char * argvName, int flags)); /* 27 */
+ int (*tk_ConfigureValue) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, char * widgRec, char * argvName, int flags)); /* 28 */
+ int (*tk_ConfigureWidget) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_ConfigSpec * specs, int argc, char ** argv, char * widgRec, int flags)); /* 29 */
+ void (*tk_ConfigureWindow) _ANSI_ARGS_((Tk_Window tkwin, unsigned int valueMask, XWindowChanges * valuePtr)); /* 30 */
+ Tk_TextLayout (*tk_ComputeTextLayout) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numChars, int wrapLength, Tk_Justify justify, int flags, int * widthPtr, int * heightPtr)); /* 31 */
+ Tk_Window (*tk_CoordsToWindow) _ANSI_ARGS_((int rootX, int rootY, Tk_Window tkwin)); /* 32 */
+ unsigned long (*tk_CreateBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr, char * command, int append)); /* 33 */
+ Tk_BindingTable (*tk_CreateBindingTable) _ANSI_ARGS_((Tcl_Interp * interp)); /* 34 */
+ Tk_ErrorHandler (*tk_CreateErrorHandler) _ANSI_ARGS_((Display * display, int errNum, int request, int minorCode, Tk_ErrorProc * errorProc, ClientData clientData)); /* 35 */
+ void (*tk_CreateEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 36 */
+ void (*tk_CreateGenericHandler) _ANSI_ARGS_((Tk_GenericProc * proc, ClientData clientData)); /* 37 */
+ void (*tk_CreateImageType) _ANSI_ARGS_((Tk_ImageType * typePtr)); /* 38 */
+ void (*tk_CreateItemType) _ANSI_ARGS_((Tk_ItemType * typePtr)); /* 39 */
+ void (*tk_CreatePhotoImageFormat) _ANSI_ARGS_((Tk_PhotoImageFormat * formatPtr)); /* 40 */
+ void (*tk_CreateSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target, Tk_SelectionProc * proc, ClientData clientData, Atom format)); /* 41 */
+ Tk_Window (*tk_CreateWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window parent, char * name, char * screenName)); /* 42 */
+ Tk_Window (*tk_CreateWindowFromPath) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * pathName, char * screenName)); /* 43 */
+ int (*tk_DefineBitmap) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, char * source, int width, int height)); /* 44 */
+ void (*tk_DefineCursor) _ANSI_ARGS_((Tk_Window window, Tk_Cursor cursor)); /* 45 */
+ void (*tk_DeleteAllBindings) _ANSI_ARGS_((Tk_BindingTable bindingTable, ClientData object)); /* 46 */
+ int (*tk_DeleteBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr)); /* 47 */
+ void (*tk_DeleteBindingTable) _ANSI_ARGS_((Tk_BindingTable bindingTable)); /* 48 */
+ void (*tk_DeleteErrorHandler) _ANSI_ARGS_((Tk_ErrorHandler handler)); /* 49 */
+ void (*tk_DeleteEventHandler) _ANSI_ARGS_((Tk_Window token, unsigned long mask, Tk_EventProc * proc, ClientData clientData)); /* 50 */
+ void (*tk_DeleteGenericHandler) _ANSI_ARGS_((Tk_GenericProc * proc, ClientData clientData)); /* 51 */
+ void (*tk_DeleteImage) _ANSI_ARGS_((Tcl_Interp * interp, char * name)); /* 52 */
+ void (*tk_DeleteSelHandler) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Atom target)); /* 53 */
+ void (*tk_DestroyWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 54 */
+ char * (*tk_DisplayName) _ANSI_ARGS_((Tk_Window tkwin)); /* 55 */
+ int (*tk_DistanceToTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 56 */
+ void (*tk_Draw3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 57 */
+ void (*tk_Draw3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 58 */
+ void (*tk_DrawChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int numBytes, int x, int y)); /* 59 */
+ void (*tk_DrawFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable)); /* 60 */
+ void (*tk_DrawTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int firstChar, int lastChar)); /* 61 */
+ void (*tk_Fill3DPolygon) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, XPoint * pointPtr, int numPoints, int borderWidth, int leftRelief)); /* 62 */
+ void (*tk_Fill3DRectangle) _ANSI_ARGS_((Tk_Window tkwin, Drawable drawable, Tk_3DBorder border, int x, int y, int width, int height, int borderWidth, int relief)); /* 63 */
+ Tk_PhotoHandle (*tk_FindPhoto) _ANSI_ARGS_((Tcl_Interp * interp, char * imageName)); /* 64 */
+ Font (*tk_FontId) _ANSI_ARGS_((Tk_Font font)); /* 65 */
+ void (*tk_Free3DBorder) _ANSI_ARGS_((Tk_3DBorder border)); /* 66 */
+ void (*tk_FreeBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap)); /* 67 */
+ void (*tk_FreeColor) _ANSI_ARGS_((XColor * colorPtr)); /* 68 */
+ void (*tk_FreeColormap) _ANSI_ARGS_((Display * display, Colormap colormap)); /* 69 */
+ void (*tk_FreeCursor) _ANSI_ARGS_((Display * display, Tk_Cursor cursor)); /* 70 */
+ void (*tk_FreeFont) _ANSI_ARGS_((Tk_Font f)); /* 71 */
+ void (*tk_FreeGC) _ANSI_ARGS_((Display * display, GC gc)); /* 72 */
+ void (*tk_FreeImage) _ANSI_ARGS_((Tk_Image image)); /* 73 */
+ void (*tk_FreeOptions) _ANSI_ARGS_((Tk_ConfigSpec * specs, char * widgRec, Display * display, int needFlags)); /* 74 */
+ void (*tk_FreePixmap) _ANSI_ARGS_((Display * display, Pixmap pixmap)); /* 75 */
+ void (*tk_FreeTextLayout) _ANSI_ARGS_((Tk_TextLayout textLayout)); /* 76 */
+ void (*tk_FreeXId) _ANSI_ARGS_((Display * display, XID xid)); /* 77 */
+ GC (*tk_GCForColor) _ANSI_ARGS_((XColor * colorPtr, Drawable drawable)); /* 78 */
+ void (*tk_GeometryRequest) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight)); /* 79 */
+ Tk_3DBorder (*tk_Get3DBorder) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid colorName)); /* 80 */
+ void (*tk_GetAllBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object)); /* 81 */
+ int (*tk_GetAnchor) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tk_Anchor * anchorPtr)); /* 82 */
+ char * (*tk_GetAtomName) _ANSI_ARGS_((Tk_Window tkwin, Atom atom)); /* 83 */
+ char * (*tk_GetBinding) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventStr)); /* 84 */
+ Pixmap (*tk_GetBitmap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 85 */
+ Pixmap (*tk_GetBitmapFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * source, int width, int height)); /* 86 */
+ int (*tk_GetCapStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * capPtr)); /* 87 */
+ XColor * (*tk_GetColor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid name)); /* 88 */
+ XColor * (*tk_GetColorByValue) _ANSI_ARGS_((Tk_Window tkwin, XColor * colorPtr)); /* 89 */
+ Colormap (*tk_GetColormap) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str)); /* 90 */
+ Tk_Cursor (*tk_GetCursor) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid str)); /* 91 */
+ Tk_Cursor (*tk_GetCursorFromData) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * source, char * mask, int width, int height, int xHot, int yHot, Tk_Uid fg, Tk_Uid bg)); /* 92 */
+ Tk_Font (*tk_GetFont) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, CONST char * str)); /* 93 */
+ Tk_Font (*tk_GetFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 94 */
+ void (*tk_GetFontMetrics) _ANSI_ARGS_((Tk_Font font, Tk_FontMetrics * fmPtr)); /* 95 */
+ GC (*tk_GetGC) _ANSI_ARGS_((Tk_Window tkwin, unsigned long valueMask, XGCValues * valuePtr)); /* 96 */
+ Tk_Image (*tk_GetImage) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * name, Tk_ImageChangedProc * changeProc, ClientData clientData)); /* 97 */
+ ClientData (*tk_GetImageMasterData) _ANSI_ARGS_((Tcl_Interp * interp, char * name, Tk_ImageType ** typePtrPtr)); /* 98 */
+ Tk_ItemType * (*tk_GetItemTypes) _ANSI_ARGS_((void)); /* 99 */
+ int (*tk_GetJoinStyle) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * joinPtr)); /* 100 */
+ int (*tk_GetJustify) _ANSI_ARGS_((Tcl_Interp * interp, char * str, Tk_Justify * justifyPtr)); /* 101 */
+ int (*tk_GetNumMainWindows) _ANSI_ARGS_((void)); /* 102 */
+ Tk_Uid (*tk_GetOption) _ANSI_ARGS_((Tk_Window tkwin, char * name, char * className)); /* 103 */
+ int (*tk_GetPixels) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, int * intPtr)); /* 104 */
+ Pixmap (*tk_GetPixmap) _ANSI_ARGS_((Display * display, Drawable d, int width, int height, int depth)); /* 105 */
+ int (*tk_GetRelief) _ANSI_ARGS_((Tcl_Interp * interp, char * name, int * reliefPtr)); /* 106 */
+ void (*tk_GetRootCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 107 */
+ int (*tk_GetScrollInfo) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, double * dblPtr, int * intPtr)); /* 108 */
+ int (*tk_GetScreenMM) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, double * doublePtr)); /* 109 */
+ int (*tk_GetSelection) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Atom selection, Atom target, Tk_GetSelProc * proc, ClientData clientData)); /* 110 */
+ Tk_Uid (*tk_GetUid) _ANSI_ARGS_((CONST char * str)); /* 111 */
+ Visual * (*tk_GetVisual) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * str, int * depthPtr, Colormap * colormapPtr)); /* 112 */
+ void (*tk_GetVRootGeometry) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr, int * widthPtr, int * heightPtr)); /* 113 */
+ int (*tk_Grab) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int grabGlobal)); /* 114 */
+ void (*tk_HandleEvent) _ANSI_ARGS_((XEvent * eventPtr)); /* 115 */
+ Tk_Window (*tk_IdToWindow) _ANSI_ARGS_((Display * display, Window window)); /* 116 */
+ void (*tk_ImageChanged) _ANSI_ARGS_((Tk_ImageMaster master, int x, int y, int width, int height, int imageWidth, int imageHeight)); /* 117 */
+ int (*tk_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 118 */
+ Atom (*tk_InternAtom) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 119 */
+ int (*tk_IntersectTextLayout) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y, int width, int height)); /* 120 */
+ void (*tk_MaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master, int x, int y, int width, int height)); /* 121 */
+ Tk_Window (*tk_MainWindow) _ANSI_ARGS_((Tcl_Interp * interp)); /* 122 */
+ void (*tk_MakeWindowExist) _ANSI_ARGS_((Tk_Window tkwin)); /* 123 */
+ void (*tk_ManageGeometry) _ANSI_ARGS_((Tk_Window tkwin, Tk_GeomMgr * mgrPtr, ClientData clientData)); /* 124 */
+ void (*tk_MapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 125 */
+ int (*tk_MeasureChars) _ANSI_ARGS_((Tk_Font tkfont, CONST char * source, int numBytes, int maxPixels, int flags, int * lengthPtr)); /* 126 */
+ void (*tk_MoveResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height)); /* 127 */
+ void (*tk_MoveWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 128 */
+ void (*tk_MoveToplevelWindow) _ANSI_ARGS_((Tk_Window tkwin, int x, int y)); /* 129 */
+ char * (*tk_NameOf3DBorder) _ANSI_ARGS_((Tk_3DBorder border)); /* 130 */
+ char * (*tk_NameOfAnchor) _ANSI_ARGS_((Tk_Anchor anchor)); /* 131 */
+ char * (*tk_NameOfBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap)); /* 132 */
+ char * (*tk_NameOfCapStyle) _ANSI_ARGS_((int cap)); /* 133 */
+ char * (*tk_NameOfColor) _ANSI_ARGS_((XColor * colorPtr)); /* 134 */
+ char * (*tk_NameOfCursor) _ANSI_ARGS_((Display * display, Tk_Cursor cursor)); /* 135 */
+ char * (*tk_NameOfFont) _ANSI_ARGS_((Tk_Font font)); /* 136 */
+ char * (*tk_NameOfImage) _ANSI_ARGS_((Tk_ImageMaster imageMaster)); /* 137 */
+ char * (*tk_NameOfJoinStyle) _ANSI_ARGS_((int join)); /* 138 */
+ char * (*tk_NameOfJustify) _ANSI_ARGS_((Tk_Justify justify)); /* 139 */
+ char * (*tk_NameOfRelief) _ANSI_ARGS_((int relief)); /* 140 */
+ Tk_Window (*tk_NameToWindow) _ANSI_ARGS_((Tcl_Interp * interp, char * pathName, Tk_Window tkwin)); /* 141 */
+ void (*tk_OwnSelection) _ANSI_ARGS_((Tk_Window tkwin, Atom selection, Tk_LostSelProc * proc, ClientData clientData)); /* 142 */
+ int (*tk_ParseArgv) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, int * argcPtr, char ** argv, Tk_ArgvInfo * argTable, int flags)); /* 143 */
+ void (*tk_PhotoPutBlock) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height)); /* 144 */
+ void (*tk_PhotoPutZoomedBlock) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY)); /* 145 */
+ int (*tk_PhotoGetImage) _ANSI_ARGS_((Tk_PhotoHandle handle, Tk_PhotoImageBlock * blockPtr)); /* 146 */
+ void (*tk_PhotoBlank) _ANSI_ARGS_((Tk_PhotoHandle handle)); /* 147 */
+ void (*tk_PhotoExpand) _ANSI_ARGS_((Tk_PhotoHandle handle, int width, int height)); /* 148 */
+ void (*tk_PhotoGetSize) _ANSI_ARGS_((Tk_PhotoHandle handle, int * widthPtr, int * heightPtr)); /* 149 */
+ void (*tk_PhotoSetSize) _ANSI_ARGS_((Tk_PhotoHandle handle, int width, int height)); /* 150 */
+ int (*tk_PointToChar) _ANSI_ARGS_((Tk_TextLayout layout, int x, int y)); /* 151 */
+ int (*tk_PostscriptFontName) _ANSI_ARGS_((Tk_Font tkfont, Tcl_DString * dsPtr)); /* 152 */
+ void (*tk_PreserveColormap) _ANSI_ARGS_((Display * display, Colormap colormap)); /* 153 */
+ void (*tk_QueueWindowEvent) _ANSI_ARGS_((XEvent * eventPtr, Tcl_QueuePosition position)); /* 154 */
+ void (*tk_RedrawImage) _ANSI_ARGS_((Tk_Image image, int imageX, int imageY, int width, int height, Drawable drawable, int drawableX, int drawableY)); /* 155 */
+ void (*tk_ResizeWindow) _ANSI_ARGS_((Tk_Window tkwin, int width, int height)); /* 156 */
+ int (*tk_RestackWindow) _ANSI_ARGS_((Tk_Window tkwin, int aboveBelow, Tk_Window other)); /* 157 */
+ Tk_RestrictProc * (*tk_RestrictEvents) _ANSI_ARGS_((Tk_RestrictProc * proc, ClientData arg, ClientData * prevArgPtr)); /* 158 */
+ int (*tk_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 159 */
+ char * (*tk_SetAppName) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 160 */
+ void (*tk_SetBackgroundFromBorder) _ANSI_ARGS_((Tk_Window tkwin, Tk_3DBorder border)); /* 161 */
+ void (*tk_SetClass) _ANSI_ARGS_((Tk_Window tkwin, char * className)); /* 162 */
+ void (*tk_SetGrid) _ANSI_ARGS_((Tk_Window tkwin, int reqWidth, int reqHeight, int gridWidth, int gridHeight)); /* 163 */
+ void (*tk_SetInternalBorder) _ANSI_ARGS_((Tk_Window tkwin, int width)); /* 164 */
+ void (*tk_SetWindowBackground) _ANSI_ARGS_((Tk_Window tkwin, unsigned long pixel)); /* 165 */
+ void (*tk_SetWindowBackgroundPixmap) _ANSI_ARGS_((Tk_Window tkwin, Pixmap pixmap)); /* 166 */
+ void (*tk_SetWindowBorder) _ANSI_ARGS_((Tk_Window tkwin, unsigned long pixel)); /* 167 */
+ void (*tk_SetWindowBorderWidth) _ANSI_ARGS_((Tk_Window tkwin, int width)); /* 168 */
+ void (*tk_SetWindowBorderPixmap) _ANSI_ARGS_((Tk_Window tkwin, Pixmap pixmap)); /* 169 */
+ void (*tk_SetWindowColormap) _ANSI_ARGS_((Tk_Window tkwin, Colormap colormap)); /* 170 */
+ int (*tk_SetWindowVisual) _ANSI_ARGS_((Tk_Window tkwin, Visual * visual, int depth, Colormap colormap)); /* 171 */
+ void (*tk_SizeOfBitmap) _ANSI_ARGS_((Display * display, Pixmap bitmap, int * widthPtr, int * heightPtr)); /* 172 */
+ void (*tk_SizeOfImage) _ANSI_ARGS_((Tk_Image image, int * widthPtr, int * heightPtr)); /* 173 */
+ int (*tk_StrictMotif) _ANSI_ARGS_((Tk_Window tkwin)); /* 174 */
+ void (*tk_TextLayoutToPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_TextLayout layout)); /* 175 */
+ int (*tk_TextWidth) _ANSI_ARGS_((Tk_Font font, CONST char * str, int numBytes)); /* 176 */
+ void (*tk_UndefineCursor) _ANSI_ARGS_((Tk_Window window)); /* 177 */
+ void (*tk_UnderlineChars) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_Font tkfont, CONST char * source, int x, int y, int firstByte, int lastByte)); /* 178 */
+ void (*tk_UnderlineTextLayout) _ANSI_ARGS_((Display * display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, int underline)); /* 179 */
+ void (*tk_Ungrab) _ANSI_ARGS_((Tk_Window tkwin)); /* 180 */
+ void (*tk_UnmaintainGeometry) _ANSI_ARGS_((Tk_Window slave, Tk_Window master)); /* 181 */
+ void (*tk_UnmapWindow) _ANSI_ARGS_((Tk_Window tkwin)); /* 182 */
+ void (*tk_UnsetGrid) _ANSI_ARGS_((Tk_Window tkwin)); /* 183 */
+ void (*tk_UpdatePointer) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int state)); /* 184 */
+ Pixmap (*tk_AllocBitmapFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 185 */
+ Tk_3DBorder (*tk_Alloc3DBorderFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 186 */
+ XColor * (*tk_AllocColorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 187 */
+ Tk_Cursor (*tk_AllocCursorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 188 */
+ Tk_Font (*tk_AllocFontFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr)); /* 189 */
+ Tk_OptionTable (*tk_CreateOptionTable) _ANSI_ARGS_((Tcl_Interp * interp, CONST Tk_OptionSpec * templatePtr)); /* 190 */
+ void (*tk_DeleteOptionTable) _ANSI_ARGS_((Tk_OptionTable optionTable)); /* 191 */
+ void (*tk_Free3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 192 */
+ void (*tk_FreeBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 193 */
+ void (*tk_FreeColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 194 */
+ void (*tk_FreeConfigOptions) _ANSI_ARGS_((char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 195 */
+ void (*tk_FreeSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 196 */
+ void (*tk_FreeCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 197 */
+ void (*tk_FreeFontFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 198 */
+ Tk_3DBorder (*tk_Get3DBorderFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 199 */
+ int (*tk_GetAnchorFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Anchor * anchorPtr)); /* 200 */
+ Pixmap (*tk_GetBitmapFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 201 */
+ XColor * (*tk_GetColorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 202 */
+ Tk_Cursor (*tk_GetCursorFromObj) _ANSI_ARGS_((Tk_Window tkwin, Tcl_Obj * objPtr)); /* 203 */
+ Tcl_Obj * (*tk_GetOptionInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 204 */
+ Tcl_Obj * (*tk_GetOptionValue) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, Tcl_Obj * namePtr, Tk_Window tkwin)); /* 205 */
+ int (*tk_GetJustifyFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tk_Justify * justifyPtr)); /* 206 */
+ int (*tk_GetMMFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, double * doublePtr)); /* 207 */
+ int (*tk_GetPixelsFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, int * intPtr)); /* 208 */
+ int (*tk_GetReliefFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * resultPtr)); /* 209 */
+ int (*tk_GetScrollInfoObj) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], double * dblPtr, int * intPtr)); /* 210 */
+ int (*tk_InitOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionToken, Tk_Window tkwin)); /* 211 */
+ void (*tk_MainEx) _ANSI_ARGS_((int argc, char ** argv, Tcl_AppInitProc * appInitProc, Tcl_Interp * interp)); /* 212 */
+ void (*tk_RestoreSavedOptions) _ANSI_ARGS_((Tk_SavedOptions * savePtr)); /* 213 */
+ int (*tk_SetOptions) _ANSI_ARGS_((Tcl_Interp * interp, char * recordPtr, Tk_OptionTable optionTable, int objc, Tcl_Obj *CONST objv[], Tk_Window tkwin, Tk_SavedOptions * savePtr, int * maskPtr)); /* 214 */
+ 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 */
+} 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
+#define Tk_PhotoPutBlock \
+ (tkStubsPtr->tk_PhotoPutBlock) /* 144 */
+#endif
+#ifndef Tk_PhotoPutZoomedBlock
+#define Tk_PhotoPutZoomedBlock \
+ (tkStubsPtr->tk_PhotoPutZoomedBlock) /* 145 */
+#endif
+#ifndef Tk_PhotoGetImage
+#define Tk_PhotoGetImage \
+ (tkStubsPtr->tk_PhotoGetImage) /* 146 */
+#endif
+#ifndef Tk_PhotoBlank
+#define Tk_PhotoBlank \
+ (tkStubsPtr->tk_PhotoBlank) /* 147 */
+#endif
+#ifndef Tk_PhotoExpand
+#define Tk_PhotoExpand \
+ (tkStubsPtr->tk_PhotoExpand) /* 148 */
+#endif
+#ifndef Tk_PhotoGetSize
+#define Tk_PhotoGetSize \
+ (tkStubsPtr->tk_PhotoGetSize) /* 149 */
+#endif
+#ifndef Tk_PhotoSetSize
+#define Tk_PhotoSetSize \
+ (tkStubsPtr->tk_PhotoSetSize) /* 150 */
+#endif
+#ifndef Tk_PointToChar
+#define Tk_PointToChar \
+ (tkStubsPtr->tk_PointToChar) /* 151 */
+#endif
+#ifndef Tk_PostscriptFontName
+#define Tk_PostscriptFontName \
+ (tkStubsPtr->tk_PostscriptFontName) /* 152 */
+#endif
+#ifndef Tk_PreserveColormap
+#define Tk_PreserveColormap \
+ (tkStubsPtr->tk_PreserveColormap) /* 153 */
+#endif
+#ifndef Tk_QueueWindowEvent
+#define Tk_QueueWindowEvent \
+ (tkStubsPtr->tk_QueueWindowEvent) /* 154 */
+#endif
+#ifndef Tk_RedrawImage
+#define Tk_RedrawImage \
+ (tkStubsPtr->tk_RedrawImage) /* 155 */
+#endif
+#ifndef Tk_ResizeWindow
+#define Tk_ResizeWindow \
+ (tkStubsPtr->tk_ResizeWindow) /* 156 */
+#endif
+#ifndef Tk_RestackWindow
+#define Tk_RestackWindow \
+ (tkStubsPtr->tk_RestackWindow) /* 157 */
+#endif
+#ifndef Tk_RestrictEvents
+#define Tk_RestrictEvents \
+ (tkStubsPtr->tk_RestrictEvents) /* 158 */
+#endif
+#ifndef Tk_SafeInit
+#define Tk_SafeInit \
+ (tkStubsPtr->tk_SafeInit) /* 159 */
+#endif
+#ifndef Tk_SetAppName
+#define Tk_SetAppName \
+ (tkStubsPtr->tk_SetAppName) /* 160 */
+#endif
+#ifndef Tk_SetBackgroundFromBorder
+#define Tk_SetBackgroundFromBorder \
+ (tkStubsPtr->tk_SetBackgroundFromBorder) /* 161 */
+#endif
+#ifndef Tk_SetClass
+#define Tk_SetClass \
+ (tkStubsPtr->tk_SetClass) /* 162 */
+#endif
+#ifndef Tk_SetGrid
+#define Tk_SetGrid \
+ (tkStubsPtr->tk_SetGrid) /* 163 */
+#endif
+#ifndef Tk_SetInternalBorder
+#define Tk_SetInternalBorder \
+ (tkStubsPtr->tk_SetInternalBorder) /* 164 */
+#endif
+#ifndef Tk_SetWindowBackground
+#define Tk_SetWindowBackground \
+ (tkStubsPtr->tk_SetWindowBackground) /* 165 */
+#endif
+#ifndef Tk_SetWindowBackgroundPixmap
+#define Tk_SetWindowBackgroundPixmap \
+ (tkStubsPtr->tk_SetWindowBackgroundPixmap) /* 166 */
+#endif
+#ifndef Tk_SetWindowBorder
+#define Tk_SetWindowBorder \
+ (tkStubsPtr->tk_SetWindowBorder) /* 167 */
+#endif
+#ifndef Tk_SetWindowBorderWidth
+#define Tk_SetWindowBorderWidth \
+ (tkStubsPtr->tk_SetWindowBorderWidth) /* 168 */
+#endif
+#ifndef Tk_SetWindowBorderPixmap
+#define Tk_SetWindowBorderPixmap \
+ (tkStubsPtr->tk_SetWindowBorderPixmap) /* 169 */
+#endif
+#ifndef Tk_SetWindowColormap
+#define Tk_SetWindowColormap \
+ (tkStubsPtr->tk_SetWindowColormap) /* 170 */
+#endif
+#ifndef Tk_SetWindowVisual
+#define Tk_SetWindowVisual \
+ (tkStubsPtr->tk_SetWindowVisual) /* 171 */
+#endif
+#ifndef Tk_SizeOfBitmap
+#define Tk_SizeOfBitmap \
+ (tkStubsPtr->tk_SizeOfBitmap) /* 172 */
+#endif
+#ifndef Tk_SizeOfImage
+#define Tk_SizeOfImage \
+ (tkStubsPtr->tk_SizeOfImage) /* 173 */
+#endif
+#ifndef Tk_StrictMotif
+#define Tk_StrictMotif \
+ (tkStubsPtr->tk_StrictMotif) /* 174 */
+#endif
+#ifndef Tk_TextLayoutToPostscript
+#define Tk_TextLayoutToPostscript \
+ (tkStubsPtr->tk_TextLayoutToPostscript) /* 175 */
+#endif
+#ifndef Tk_TextWidth
+#define Tk_TextWidth \
+ (tkStubsPtr->tk_TextWidth) /* 176 */
+#endif
+#ifndef Tk_UndefineCursor
+#define Tk_UndefineCursor \
+ (tkStubsPtr->tk_UndefineCursor) /* 177 */
+#endif
+#ifndef Tk_UnderlineChars
+#define Tk_UnderlineChars \
+ (tkStubsPtr->tk_UnderlineChars) /* 178 */
+#endif
+#ifndef Tk_UnderlineTextLayout
+#define Tk_UnderlineTextLayout \
+ (tkStubsPtr->tk_UnderlineTextLayout) /* 179 */
+#endif
+#ifndef Tk_Ungrab
+#define Tk_Ungrab \
+ (tkStubsPtr->tk_Ungrab) /* 180 */
+#endif
+#ifndef Tk_UnmaintainGeometry
+#define Tk_UnmaintainGeometry \
+ (tkStubsPtr->tk_UnmaintainGeometry) /* 181 */
+#endif
+#ifndef Tk_UnmapWindow
+#define Tk_UnmapWindow \
+ (tkStubsPtr->tk_UnmapWindow) /* 182 */
+#endif
+#ifndef Tk_UnsetGrid
+#define Tk_UnsetGrid \
+ (tkStubsPtr->tk_UnsetGrid) /* 183 */
+#endif
+#ifndef Tk_UpdatePointer
+#define Tk_UpdatePointer \
+ (tkStubsPtr->tk_UpdatePointer) /* 184 */
+#endif
+#ifndef Tk_AllocBitmapFromObj
+#define Tk_AllocBitmapFromObj \
+ (tkStubsPtr->tk_AllocBitmapFromObj) /* 185 */
+#endif
+#ifndef Tk_Alloc3DBorderFromObj
+#define Tk_Alloc3DBorderFromObj \
+ (tkStubsPtr->tk_Alloc3DBorderFromObj) /* 186 */
+#endif
+#ifndef Tk_AllocColorFromObj
+#define Tk_AllocColorFromObj \
+ (tkStubsPtr->tk_AllocColorFromObj) /* 187 */
+#endif
+#ifndef Tk_AllocCursorFromObj
+#define Tk_AllocCursorFromObj \
+ (tkStubsPtr->tk_AllocCursorFromObj) /* 188 */
+#endif
+#ifndef Tk_AllocFontFromObj
+#define Tk_AllocFontFromObj \
+ (tkStubsPtr->tk_AllocFontFromObj) /* 189 */
+#endif
+#ifndef Tk_CreateOptionTable
+#define Tk_CreateOptionTable \
+ (tkStubsPtr->tk_CreateOptionTable) /* 190 */
+#endif
+#ifndef Tk_DeleteOptionTable
+#define Tk_DeleteOptionTable \
+ (tkStubsPtr->tk_DeleteOptionTable) /* 191 */
+#endif
+#ifndef Tk_Free3DBorderFromObj
+#define Tk_Free3DBorderFromObj \
+ (tkStubsPtr->tk_Free3DBorderFromObj) /* 192 */
+#endif
+#ifndef Tk_FreeBitmapFromObj
+#define Tk_FreeBitmapFromObj \
+ (tkStubsPtr->tk_FreeBitmapFromObj) /* 193 */
+#endif
+#ifndef Tk_FreeColorFromObj
+#define Tk_FreeColorFromObj \
+ (tkStubsPtr->tk_FreeColorFromObj) /* 194 */
+#endif
+#ifndef Tk_FreeConfigOptions
+#define Tk_FreeConfigOptions \
+ (tkStubsPtr->tk_FreeConfigOptions) /* 195 */
+#endif
+#ifndef Tk_FreeSavedOptions
+#define Tk_FreeSavedOptions \
+ (tkStubsPtr->tk_FreeSavedOptions) /* 196 */
+#endif
+#ifndef Tk_FreeCursorFromObj
+#define Tk_FreeCursorFromObj \
+ (tkStubsPtr->tk_FreeCursorFromObj) /* 197 */
+#endif
+#ifndef Tk_FreeFontFromObj
+#define Tk_FreeFontFromObj \
+ (tkStubsPtr->tk_FreeFontFromObj) /* 198 */
+#endif
+#ifndef Tk_Get3DBorderFromObj
+#define Tk_Get3DBorderFromObj \
+ (tkStubsPtr->tk_Get3DBorderFromObj) /* 199 */
+#endif
+#ifndef Tk_GetAnchorFromObj
+#define Tk_GetAnchorFromObj \
+ (tkStubsPtr->tk_GetAnchorFromObj) /* 200 */
+#endif
+#ifndef Tk_GetBitmapFromObj
+#define Tk_GetBitmapFromObj \
+ (tkStubsPtr->tk_GetBitmapFromObj) /* 201 */
+#endif
+#ifndef Tk_GetColorFromObj
+#define Tk_GetColorFromObj \
+ (tkStubsPtr->tk_GetColorFromObj) /* 202 */
+#endif
+#ifndef Tk_GetCursorFromObj
+#define Tk_GetCursorFromObj \
+ (tkStubsPtr->tk_GetCursorFromObj) /* 203 */
+#endif
+#ifndef Tk_GetOptionInfo
+#define Tk_GetOptionInfo \
+ (tkStubsPtr->tk_GetOptionInfo) /* 204 */
+#endif
+#ifndef Tk_GetOptionValue
+#define Tk_GetOptionValue \
+ (tkStubsPtr->tk_GetOptionValue) /* 205 */
+#endif
+#ifndef Tk_GetJustifyFromObj
+#define Tk_GetJustifyFromObj \
+ (tkStubsPtr->tk_GetJustifyFromObj) /* 206 */
+#endif
+#ifndef Tk_GetMMFromObj
+#define Tk_GetMMFromObj \
+ (tkStubsPtr->tk_GetMMFromObj) /* 207 */
+#endif
+#ifndef Tk_GetPixelsFromObj
+#define Tk_GetPixelsFromObj \
+ (tkStubsPtr->tk_GetPixelsFromObj) /* 208 */
+#endif
+#ifndef Tk_GetReliefFromObj
+#define Tk_GetReliefFromObj \
+ (tkStubsPtr->tk_GetReliefFromObj) /* 209 */
+#endif
+#ifndef Tk_GetScrollInfoObj
+#define Tk_GetScrollInfoObj \
+ (tkStubsPtr->tk_GetScrollInfoObj) /* 210 */
+#endif
+#ifndef Tk_InitOptions
+#define Tk_InitOptions \
+ (tkStubsPtr->tk_InitOptions) /* 211 */
+#endif
+#ifndef Tk_MainEx
+#define Tk_MainEx \
+ (tkStubsPtr->tk_MainEx) /* 212 */
+#endif
+#ifndef Tk_RestoreSavedOptions
+#define Tk_RestoreSavedOptions \
+ (tkStubsPtr->tk_RestoreSavedOptions) /* 213 */
+#endif
+#ifndef Tk_SetOptions
+#define Tk_SetOptions \
+ (tkStubsPtr->tk_SetOptions) /* 214 */
+#endif
+#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
+
+#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/tk/generic/tkEntry.c b/tk/generic/tkEntry.c
index 86da2fd92e2..6ed11d6f9b7 100644
--- a/tk/generic/tkEntry.c
+++ b/tk/generic/tkEntry.c
@@ -6,7 +6,7 @@
* the string to be edited.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -32,6 +32,9 @@ typedef struct {
* freed even after tkwin has gone away. */
Tcl_Interp *interp; /* Interpreter associated with entry. */
Tcl_Command widgetCmd; /* Token for entry's widget command. */
+ Tk_OptionTable optionTable; /* Table that defines configuration options
+ * available for this widget. */
+
/*
* Fields that are set by widget commands other than "configure".
@@ -39,17 +42,17 @@ typedef struct {
char *string; /* Pointer to storage for string;
* NULL-terminated; malloc-ed. */
- int insertPos; /* Index of character before which next
- * typed character will be inserted. */
+ int insertPos; /* Character index before which next typed
+ * character will be inserted. */
/*
* Information about what's selected, if any.
*/
- int selectFirst; /* Index of first selected character (-1 means
- * nothing selected. */
- int selectLast; /* Index of last selected character (-1 means
- * nothing selected. */
+ int 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). */
@@ -60,8 +63,8 @@ typedef struct {
int scanMarkX; /* X-position at which scan started (e.g.
* button was pressed here). */
- int scanMarkIndex; /* Index of character that was at left of
- * window when scan started. */
+ int scanMarkIndex; /* Character index of character that was at
+ * left of window when scan started. */
/*
* Configuration settings that are updated by Tk_ConfigureWidget.
@@ -99,7 +102,7 @@ typedef struct {
char *showChar; /* Value of -show option. If non-NULL, first
* character is used for displaying all
* characters in entry. Malloc'ed. */
- Tk_Uid state; /* Normal or disabled. Entry is read-only
+ 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
@@ -118,20 +121,27 @@ typedef struct {
* configuration settings above.
*/
- int numChars; /* Number of non-NULL characters in
- * string (may be 0). */
- char *displayString; /* If non-NULL, points to string with same
+ int numBytes; /* Length of string in bytes. */
+ int numChars; /* Length of string in characters. Both
+ * string and displayString have the same
+ * character length, but may have different
+ * byte lengths due to being made from
+ * different UTF-8 characters. */
+ char *displayString; /* String to use when displaying. This may
+ * be a pointer to string, or a pointer to
+ * malloced memory with the same character
* length as string but whose characters
- * are all equal to showChar. Malloc'ed. */
+ * are all equal to showChar. */
+ int numDisplayBytes; /* Length of displayString in bytes. */
int inset; /* Number of pixels on the left and right
* sides that are taken up by XPAD, borderWidth
* (if any), and highlightWidth (if any). */
Tk_TextLayout textLayout; /* Cached text layout information. */
int layoutX, layoutY; /* Origin for layout. */
- int leftIndex; /* Index of left-most character visible in
- * window. */
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. */
@@ -141,6 +151,14 @@ typedef struct {
int avgWidth; /* Width of average character. */
int flags; /* Miscellaneous flags; see below for
* definitions. */
+ Tk_TSOffset tsoffset;
+
+ char *validateCmd; /* Command prefix to use when invoking
+ * validate command. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int validate; /* Non-zero means try to validate */
+ char *invalidCmd; /* Command called when a validation returns 0
+ * (successfully fails), defaults to {}. */
} Entry;
/*
@@ -159,6 +177,12 @@ typedef struct {
* 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
@@ -167,6 +191,10 @@ typedef struct {
#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
@@ -177,93 +205,139 @@ typedef struct {
#define YPAD 1
/*
+ * The following enum is used to define a type for the -state option
+ * of the Entry widget. These values are used as indices into the
+ * string table below.
+ */
+
+enum state {
+ STATE_DISABLED, STATE_NORMAL
+};
+
+static char *stateStrings[] = {
+ "disabled", "normal", (char *) NULL
+};
+
+/*
+ * 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
+};
+#define DEF_ENTRY_VALIDATE "none"
+#define DEF_ENTRY_INVALIDCMD ""
+
+/*
* Information used for argv parsing.
*/
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_ENTRY_BG_COLOR, Tk_Offset(Entry, normalBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_ENTRY_BG_MONO, Tk_Offset(Entry, normalBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_ENTRY_BORDER_WIDTH, Tk_Offset(Entry, borderWidth), 0},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_ENTRY_CURSOR, Tk_Offset(Entry, cursor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
- "ExportSelection", DEF_ENTRY_EXPORT_SELECTION,
- Tk_Offset(Entry, exportSelection), 0},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_ENTRY_FONT, Tk_Offset(Entry, tkfont), 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_ENTRY_FG, Tk_Offset(Entry, fgColorPtr), 0},
- {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+static Tk_OptionSpec optionSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ DEF_ENTRY_BG_COLOR, -1, Tk_Offset(Entry, normalBorder),
+ 0, (ClientData) DEF_ENTRY_BG_MONO, 0},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_ENTRY_BORDER_WIDTH, -1, Tk_Offset(Entry, borderWidth),
+ 0, 0, 0},
+ {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_ENTRY_CURSOR, -1, Tk_Offset(Entry, cursor),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_ENTRY_EXPORT_SELECTION, -1,
+ Tk_Offset(Entry, exportSelection), 0, 0, 0},
+ {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_ENTRY_FONT, -1, Tk_Offset(Entry, tkfont), 0, 0, 0},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_ENTRY_FG, -1, Tk_Offset(Entry, fgColorPtr), 0,
+ 0, 0},
+ {TK_OPTION_COLOR, "-highlightbackground", "highlightBackground",
"HighlightBackground", DEF_ENTRY_HIGHLIGHT_BG,
- Tk_Offset(Entry, highlightBgColorPtr), 0},
- {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
- DEF_ENTRY_HIGHLIGHT, Tk_Offset(Entry, highlightColorPtr), 0},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
- "HighlightThickness",
- DEF_ENTRY_HIGHLIGHT_WIDTH, Tk_Offset(Entry, highlightWidth), 0},
- {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
- DEF_ENTRY_INSERT_BG, Tk_Offset(Entry, insertBorder), 0},
- {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
- DEF_ENTRY_INSERT_BD_COLOR, Tk_Offset(Entry, insertBorderWidth),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
- DEF_ENTRY_INSERT_BD_MONO, Tk_Offset(Entry, insertBorderWidth),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
- DEF_ENTRY_INSERT_OFF_TIME, Tk_Offset(Entry, insertOffTime), 0},
- {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
- DEF_ENTRY_INSERT_ON_TIME, Tk_Offset(Entry, insertOnTime), 0},
- {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
- DEF_ENTRY_INSERT_WIDTH, Tk_Offset(Entry, insertWidth), 0},
- {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
- DEF_ENTRY_JUSTIFY, Tk_Offset(Entry, justify), 0},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_ENTRY_RELIEF, Tk_Offset(Entry, relief), 0},
- {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
- DEF_ENTRY_SELECT_COLOR, Tk_Offset(Entry, selBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
- DEF_ENTRY_SELECT_MONO, Tk_Offset(Entry, selBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
- DEF_ENTRY_SELECT_BD_COLOR, Tk_Offset(Entry, selBorderWidth),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
- DEF_ENTRY_SELECT_BD_MONO, Tk_Offset(Entry, selBorderWidth),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
- DEF_ENTRY_SELECT_FG_COLOR, Tk_Offset(Entry, selFgColorPtr),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
- DEF_ENTRY_SELECT_FG_MONO, Tk_Offset(Entry, selFgColorPtr),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_STRING, "-show", "show", "Show",
- DEF_ENTRY_SHOW, Tk_Offset(Entry, showChar), TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-state", "state", "State",
- DEF_ENTRY_STATE, Tk_Offset(Entry, state), 0},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_ENTRY_TAKE_FOCUS, Tk_Offset(Entry, takeFocus), TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
- DEF_ENTRY_TEXT_VARIABLE, Tk_Offset(Entry, textVarName),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_INT, "-width", "width", "Width",
- DEF_ENTRY_WIDTH, Tk_Offset(Entry, prefWidth), 0},
- {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
- DEF_ENTRY_SCROLL_COMMAND, Tk_Offset(Entry, scrollCmd),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+ -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_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}
};
/*
@@ -274,12 +348,38 @@ static Tk_ConfigSpec configSpecs[] = {
#define LAST_PLUS_ONE_OK 2
/*
+ * The following tables define the entry widget commands (and sub-
+ * commands) and map the indexes into the string tables into
+ * enumerated types used to dispatch the entry widget command.
+ */
+
+static char *commandNames[] = {
+ "bbox", "cget", "configure", "delete", "get", "icursor", "index",
+ "insert", "scan", "selection", "validate", "xview", (char *) NULL
+};
+
+enum command {
+ COMMAND_BBOX, COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_DELETE,
+ COMMAND_GET, COMMAND_ICURSOR, COMMAND_INDEX, COMMAND_INSERT,
+ COMMAND_SCAN, COMMAND_SELECTION, COMMAND_VALIDATE, COMMAND_XVIEW
+};
+
+static char *selCommandNames[] = {
+ "adjust", "clear", "from", "present", "range", "to", (char *) NULL
+};
+
+enum selcommand {
+ SELECTION_ADJUST, SELECTION_CLEAR, SELECTION_FROM,
+ SELECTION_PRESENT, SELECTION_RANGE, SELECTION_TO
+};
+
+/*
* Forward declarations for procedures defined later in this file:
*/
static int ConfigureEntry _ANSI_ARGS_((Tcl_Interp *interp,
- Entry *entryPtr, int argc, char **argv,
- int flags));
+ 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));
@@ -306,11 +406,19 @@ static char * EntryTextVarProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, 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, char *new, int index, int type));
+static void ExpandPercents _ANSI_ARGS_((Entry *entryPtr,
+ char *before, char *change, char *new,
+ int index, int type, Tcl_DString *dsPtr));
static void EntryValueChanged _ANSI_ARGS_((Entry *entryPtr));
static void EntryVisibleRange _ANSI_ARGS_((Entry *entryPtr,
double *firstPtr, double *lastPtr));
-static int EntryWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static 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,
@@ -333,7 +441,7 @@ static TkClassProcs entryClass = {
/*
*--------------------------------------------------------------
*
- * Tk_EntryCmd --
+ * Tk_EntryObjCmd --
*
* This procedure is invoked to process the "entry" Tcl
* command. See the user documentation for details on what
@@ -349,25 +457,43 @@ static TkClassProcs entryClass = {
*/
int
-Tk_EntryCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_EntryObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
register Entry *entryPtr;
- Tk_Window new;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ optionTable = (Tk_OptionTable) clientData;
+ if (optionTable == NULL) {
+ Tcl_CmdInfo info;
+ char *name;
+
+ /*
+ * We haven't created the option table for this widget class
+ * yet. Do it now and save the table as the clientData for
+ * the command, so we'll have access to it in future
+ * invocations of the command.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+ name = Tcl_GetString(objv[0]);
+ Tcl_GetCommandInfo(interp, name, &info);
+ info.objClientData = (ClientData) optionTable;
+ Tcl_SetCommandInfo(interp, name, &info);
+ }
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
- if (new == NULL) {
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -377,62 +503,67 @@ Tk_EntryCmd(clientData, interp, argc, argv)
* initialized already (e.g. resource pointers).
*/
- entryPtr = (Entry *) ckalloc(sizeof(Entry));
- entryPtr->tkwin = new;
- entryPtr->display = Tk_Display(new);
- entryPtr->interp = interp;
- entryPtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(entryPtr->tkwin), EntryWidgetCmd,
+ entryPtr = (Entry *) ckalloc(sizeof(Entry));
+ entryPtr->tkwin = tkwin;
+ entryPtr->display = Tk_Display(tkwin);
+ entryPtr->interp = interp;
+ entryPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(entryPtr->tkwin), EntryWidgetObjCmd,
(ClientData) entryPtr, EntryCmdDeletedProc);
- entryPtr->string = (char *) ckalloc(1);
- entryPtr->string[0] = '\0';
- entryPtr->insertPos = 0;
- entryPtr->selectFirst = -1;
- entryPtr->selectLast = -1;
- entryPtr->selectAnchor = 0;
- entryPtr->scanMarkX = 0;
- entryPtr->scanMarkIndex = 0;
-
- entryPtr->normalBorder = NULL;
- entryPtr->borderWidth = 0;
- entryPtr->cursor = None;
- entryPtr->exportSelection = 1;
- entryPtr->tkfont = NULL;
- entryPtr->fgColorPtr = NULL;
- entryPtr->highlightBgColorPtr = NULL;
- entryPtr->highlightColorPtr = NULL;
- entryPtr->highlightWidth = 0;
- entryPtr->insertBorder = NULL;
- entryPtr->insertBorderWidth = 0;
- entryPtr->insertOffTime = 0;
- entryPtr->insertOnTime = 0;
- entryPtr->insertWidth = 0;
- entryPtr->justify = TK_JUSTIFY_LEFT;
- entryPtr->relief = TK_RELIEF_FLAT;
- entryPtr->selBorder = NULL;
- entryPtr->selBorderWidth = 0;
- entryPtr->selFgColorPtr = NULL;
- entryPtr->showChar = NULL;
- entryPtr->state = tkNormalUid;
- entryPtr->textVarName = NULL;
- entryPtr->takeFocus = NULL;
- entryPtr->prefWidth = 0;
- entryPtr->scrollCmd = NULL;
-
- entryPtr->numChars = 0;
- entryPtr->displayString = NULL;
- entryPtr->inset = XPAD;
- entryPtr->textLayout = NULL;
- entryPtr->layoutX = 0;
- entryPtr->layoutY = 0;
- entryPtr->leftIndex = 0;
- entryPtr->leftX = 0;
- entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
- entryPtr->textGC = None;
- entryPtr->selTextGC = None;
- entryPtr->highlightGC = None;
- entryPtr->avgWidth = 1;
- entryPtr->flags = 0;
+ entryPtr->optionTable = optionTable;
+ entryPtr->string = (char *) ckalloc(1);
+ entryPtr->string[0] = '\0';
+ entryPtr->insertPos = 0;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
+ entryPtr->selectAnchor = 0;
+ entryPtr->scanMarkX = 0;
+ entryPtr->scanMarkIndex = 0;
+
+ entryPtr->normalBorder = NULL;
+ entryPtr->borderWidth = 0;
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->tkfont = NULL;
+ entryPtr->fgColorPtr = NULL;
+ entryPtr->highlightBgColorPtr = NULL;
+ entryPtr->highlightColorPtr = NULL;
+ entryPtr->highlightWidth = 0;
+ entryPtr->insertBorder = NULL;
+ entryPtr->insertBorderWidth = 0;
+ entryPtr->insertOffTime = 0;
+ entryPtr->insertOnTime = 0;
+ entryPtr->insertWidth = 0;
+ entryPtr->justify = TK_JUSTIFY_LEFT;
+ entryPtr->relief = TK_RELIEF_FLAT;
+ entryPtr->selBorder = NULL;
+ entryPtr->selBorderWidth = 0;
+ entryPtr->selFgColorPtr = NULL;
+ entryPtr->showChar = NULL;
+ entryPtr->state = STATE_NORMAL;
+ entryPtr->textVarName = NULL;
+ entryPtr->takeFocus = NULL;
+ entryPtr->prefWidth = 0;
+ entryPtr->scrollCmd = NULL;
+ entryPtr->numBytes = 0;
+ entryPtr->numChars = 0;
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = 0;
+ entryPtr->inset = XPAD;
+ entryPtr->textLayout = NULL;
+ entryPtr->layoutX = 0;
+ entryPtr->layoutY = 0;
+ entryPtr->leftX = 0;
+ entryPtr->leftIndex = 0;
+ entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ entryPtr->textGC = None;
+ entryPtr->selTextGC = None;
+ entryPtr->highlightGC = None;
+ entryPtr->avgWidth = 1;
+ entryPtr->flags = 0;
+ entryPtr->validateCmd = NULL;
+ entryPtr->validate = VALIDATE_NONE;
+ entryPtr->invalidCmd = NULL;
Tk_SetClass(entryPtr->tkwin, "Entry");
TkSetClassProcs(entryPtr->tkwin, &entryClass, (ClientData) entryPtr);
@@ -441,22 +572,22 @@ Tk_EntryCmd(clientData, interp, argc, argv)
EntryEventProc, (ClientData) entryPtr);
Tk_CreateSelHandler(entryPtr->tkwin, XA_PRIMARY, XA_STRING,
EntryFetchSelection, (ClientData) entryPtr, XA_STRING);
- if (ConfigureEntry(interp, entryPtr, argc-2, argv+2, 0) != TCL_OK) {
- goto error;
- }
- interp->result = Tk_PathName(entryPtr->tkwin);
+ 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;
-
- error:
- Tk_DestroyWindow(entryPtr->tkwin);
- return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
- * EntryWidgetCmd --
+ * EntryWidgetObjCmd --
*
* This procedure is invoked to process the Tcl command
* that corresponds to a widget managed by this module.
@@ -472,321 +603,414 @@ Tk_EntryCmd(clientData, interp, argc, argv)
*/
static int
-EntryWidgetCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Information about entry widget. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+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. */
{
- register Entry *entryPtr = (Entry *) clientData;
- int result = TCL_OK;
- size_t length;
- int c;
+ Entry *entryPtr = (Entry *) clientData;
+ int cmdIndex, selIndex, result;
+ Tcl_Obj *objPtr;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
Tcl_Preserve((ClientData) entryPtr);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
- int index;
- int x, y, width, height;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " bbox index\"",
- (char *) NULL);
- goto error;
- }
- if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
- goto error;
- }
- if ((index == entryPtr->numChars) && (index > 0)) {
- index--;
- }
- Tk_CharBbox(entryPtr->textLayout, index, &x, &y, &width, &height);
- sprintf(interp->result, "%d %d %d %d",
- x + entryPtr->layoutX, y + entryPtr->layoutY, width, height);
- } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
- }
- result = Tk_ConfigureValue(interp, entryPtr->tkwin, configSpecs,
- (char *) entryPtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs,
- (char *) entryPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, entryPtr->tkwin, configSpecs,
- (char *) entryPtr, argv[2], 0);
- } else {
- result = ConfigureEntry(interp, entryPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- int first, last;
-
- if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " delete firstIndex ?lastIndex?\"",
- (char *) NULL);
- goto error;
- }
- if (GetEntryIndex(interp, entryPtr, argv[2], &first) != TCL_OK) {
- goto error;
- }
- if (argc == 3) {
- last = first+1;
- } else {
- if (GetEntryIndex(interp, entryPtr, argv[3], &last) != TCL_OK) {
+
+ /*
+ * Parse the widget command by looking up the second token in
+ * the list of valid command names.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
+ "option", 0, &cmdIndex);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ switch (cmdIndex) {
+ case COMMAND_BBOX: {
+ int index, x, y, width, height;
+ char buf[TCL_INTEGER_SPACE * 4];
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
goto error;
}
- }
- if ((last >= first) && (entryPtr->state == tkNormalUid)) {
- DeleteChars(entryPtr, first, last-first);
- }
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " get\"", (char *) NULL);
- goto error;
- }
- interp->result = entryPtr->string;
- } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " icursor pos\"",
- (char *) NULL);
- goto error;
- }
- if (GetEntryIndex(interp, entryPtr, argv[2], &entryPtr->insertPos)
- != TCL_OK) {
- goto error;
- }
- EventuallyRedraw(entryPtr);
- } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " index string\"", (char *) NULL);
- goto error;
- }
- if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
- goto error;
- }
- sprintf(interp->result, "%d", index);
- } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " insert index text\"",
- (char *) NULL);
- goto error;
- }
- if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
- goto error;
- }
- if (entryPtr->state == tkNormalUid) {
- InsertChars(entryPtr, index, argv[3]);
- }
- } else if ((c == 's') && (length >= 2)
- && (strncmp(argv[1], "scan", length) == 0)) {
- int x;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " scan mark|dragto x\"", (char *) NULL);
- goto error;
- }
- if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) {
- goto error;
- }
- if ((argv[2][0] == 'm')
- && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
- entryPtr->scanMarkX = x;
- entryPtr->scanMarkIndex = entryPtr->leftIndex;
- } else if ((argv[2][0] == 'd')
- && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
- EntryScanTo(entryPtr, x);
- } else {
- Tcl_AppendResult(interp, "bad scan option \"", argv[2],
- "\": must be mark or dragto", (char *) NULL);
- goto error;
- }
- } else if ((c == 's') && (length >= 2)
- && (strncmp(argv[1], "selection", length) == 0)) {
- int index, index2;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " select option ?index?\"", (char *) NULL);
- goto error;
- }
- length = strlen(argv[2]);
- c = argv[2][0];
- if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection clear\"", (char *) NULL);
- goto error;
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
}
- if (entryPtr->selectFirst != -1) {
- entryPtr->selectFirst = entryPtr->selectLast = -1;
- EventuallyRedraw(entryPtr);
+ if ((index == entryPtr->numChars) && (index > 0)) {
+ index--;
}
- goto done;
- } else if ((c == 'p') && (strncmp(argv[2], "present", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection present\"", (char *) NULL);
+ 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;
}
- if (entryPtr->selectFirst == -1) {
- interp->result = "0";
+
+ objPtr = Tk_GetOptionValue(interp, (char *) entryPtr,
+ entryPtr->optionTable, objv[2], entryPtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
} else {
- interp->result = "1";
+ Tcl_SetObjResult(interp, objPtr);
}
- goto done;
+ break;
}
- if (argc >= 4) {
- if (GetEntryIndex(interp, entryPtr, argv[3], &index) != TCL_OK) {
- goto error;
+
+ 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;
}
- if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection adjust index\"",
- (char *) NULL);
+
+ case COMMAND_DELETE: {
+ int first, last;
+
+ if ((objc < 3) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "firstIndex ?lastIndex?");
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.
- */
+ 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;
}
}
- EntrySelectTo(entryPtr, index);
- } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection from index\"",
- (char *) NULL);
+ 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;
}
- entryPtr->selectAnchor = index;
- } else if ((c == 'r') && (strncmp(argv[2], "range", length) == 0)) {
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection range start end\"",
- (char *) NULL);
+ Tcl_SetResult(interp, entryPtr->string, TCL_STATIC);
+ break;
+ }
+
+ case COMMAND_ICURSOR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "pos");
goto error;
}
- if (GetEntryIndex(interp, entryPtr, argv[4], &index2) != TCL_OK) {
+ 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 (index >= index2) {
- entryPtr->selectFirst = entryPtr->selectLast = -1;
- } else {
- entryPtr->selectFirst = index;
- entryPtr->selectLast = index2;
+ if (GetEntryIndex(interp, entryPtr, Tcl_GetString(objv[2]),
+ &index) != TCL_OK) {
+ goto error;
}
- if (!(entryPtr->flags & GOT_SELECTION)
- && (entryPtr->exportSelection)) {
- Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY,
- EntryLostSelection, (ClientData) entryPtr);
- entryPtr->flags |= GOT_SELECTION;
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ break;
+ }
+
+ case COMMAND_INSERT: {
+ int index;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index text");
+ goto error;
}
- EventuallyRedraw(entryPtr);
- } else if ((c == 't') && (strncmp(argv[2], "to", length) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection to index\"",
- (char *) NULL);
+ 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;
}
- EntrySelectTo(entryPtr, index);
- } else {
- Tcl_AppendResult(interp, "bad selection option \"", argv[2],
- "\": must be adjust, clear, from, present, range, or to",
- (char *) NULL);
- goto error;
+ 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;
}
- } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
- int index, type, count, charsPerPage;
- double fraction, first, last;
-
- if (argc == 2) {
- EntryVisibleRange(entryPtr, &first, &last);
- sprintf(interp->result, "%g %g", first, last);
- goto done;
- } else if (argc == 3) {
- if (GetEntryIndex(interp, entryPtr, argv[2], &index) != TCL_OK) {
+
+ case COMMAND_SELECTION: {
+ int index, index2;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option ?index?");
goto error;
}
- } else {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
- index = entryPtr->leftIndex;
- switch (type) {
- case TK_SCROLL_ERROR:
- goto error;
- case TK_SCROLL_MOVETO:
- index = (int) ((fraction * entryPtr->numChars) + 0.5);
+
+ /*
+ * Parse the selection sub-command, using the command
+ * table "selCommandNames" defined above.
+ */
+
+ result = Tcl_GetIndexFromObj(interp, objv[2], selCommandNames,
+ "selection option", 0, &selIndex);
+ if (result != TCL_OK) {
+ goto error;
+ }
+
+ switch(selIndex) {
+ case SELECTION_ADJUST: {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 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 TK_SCROLL_PAGES:
- charsPerPage = ((Tk_Width(entryPtr->tkwin)
- - 2*entryPtr->inset) / entryPtr->avgWidth) - 2;
- if (charsPerPage < 1) {
- charsPerPage = 1;
+ }
+
+ case SELECTION_CLEAR: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, (char *) NULL);
+ goto error;
}
- index += charsPerPage*count;
+ 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 TK_SCROLL_UNITS:
- index += count;
+ }
+
+ 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;
}
- if (index >= entryPtr->numChars) {
- index = entryPtr->numChars-1;
- }
- if (index < 0) {
- index = 0;
+
+ 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;
}
- entryPtr->leftIndex = index;
- entryPtr->flags |= UPDATE_SCROLLBAR;
- EntryComputeGeometry(entryPtr);
- EventuallyRedraw(entryPtr);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be bbox, cget, configure, delete, get, ",
- "icursor, index, insert, scan, selection, or xview",
- (char *) NULL);
- goto error;
}
+
done:
Tcl_Release((ClientData) entryPtr);
return result;
@@ -818,7 +1042,13 @@ static void
DestroyEntry(memPtr)
char *memPtr; /* Info about entry widget. */
{
- register Entry *entryPtr = (Entry *) memPtr;
+ Entry *entryPtr = (Entry *) memPtr;
+ entryPtr->flags |= ENTRY_DELETED;
+
+ Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd);
+ if (entryPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr);
+ }
/*
* Free up all the stuff that requires special handling, then
@@ -839,11 +1069,13 @@ DestroyEntry(memPtr)
Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
}
Tcl_DeleteTimerHandler(entryPtr->insertBlinkHandler);
- if (entryPtr->displayString != NULL) {
+ if (entryPtr->displayString != entryPtr->string) {
ckfree(entryPtr->displayString);
}
Tk_FreeTextLayout(entryPtr->textLayout);
- Tk_FreeOptions(configSpecs, (char *) entryPtr, entryPtr->display, 0);
+ Tk_FreeConfigOptions((char *) entryPtr, entryPtr->optionTable,
+ entryPtr->tkwin);
+ entryPtr->tkwin = NULL;
ckfree((char *) entryPtr);
}
@@ -858,7 +1090,7 @@ DestroyEntry(memPtr)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, border width,
@@ -869,14 +1101,17 @@ DestroyEntry(memPtr)
*/
static int
-ConfigureEntry(interp, entryPtr, argc, argv, flags)
+ConfigureEntry(interp, entryPtr, objc, objv, flags)
Tcl_Interp *interp; /* Used for error reporting. */
- register Entry *entryPtr; /* Information about widget; may or may
- * not already have values for some fields. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
+ Entry *entryPtr; /* Information about widget; may or may not
+ * already have values for some fields. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
int oldExport;
/*
@@ -890,9 +1125,83 @@ ConfigureEntry(interp, entryPtr, argc, argv, flags)
}
oldExport = entryPtr->exportSelection;
- if (Tk_ConfigureWidget(interp, entryPtr->tkwin, configSpecs,
- argc, argv, (char *) entryPtr, flags) != TCL_OK) {
- return TCL_ERROR;
+
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
+
+ if (Tk_SetOptions(interp, (char *) entryPtr,
+ entryPtr->optionTable, objc, objv,
+ entryPtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {
+ continue;
+ }
+ } else {
+ /*
+ * Second pass: restore options to old values.
+ */
+
+ errorResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(errorResult);
+ Tk_RestoreSavedOptions(&savedOptions);
+ }
+
+ /*
+ * A few other options also need special processing, such as parsing
+ * the geometry and setting the background from a 3-D border.
+ */
+
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder);
+
+ if (entryPtr->insertWidth <= 0) {
+ entryPtr->insertWidth = 2;
+ }
+ if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
+ entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
+ }
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or
+ * off-time just changed. 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);
}
/*
@@ -915,63 +1224,14 @@ ConfigureEntry(interp, entryPtr, argc, argv, flags)
EntryTextVarProc, (ClientData) entryPtr);
}
- /*
- * A few other options also need special processing, such as parsing
- * the geometry and setting the background from a 3-D border.
- */
-
- if ((entryPtr->state != tkNormalUid)
- && (entryPtr->state != tkDisabledUid)) {
- Tcl_AppendResult(interp, "bad state value \"", entryPtr->state,
- "\": must be normal or disabled", (char *) NULL);
- entryPtr->state = tkNormalUid;
+ EntryWorldChanged((ClientData) entryPtr);
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
return TCL_ERROR;
+ } else {
+ return TCL_OK;
}
-
- Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder);
-
- if (entryPtr->insertWidth <= 0) {
- entryPtr->insertWidth = 2;
- }
- if (entryPtr->insertBorderWidth > entryPtr->insertWidth/2) {
- entryPtr->insertBorderWidth = entryPtr->insertWidth/2;
- }
-
- /*
- * Restart the cursor timing sequence in case the on-time or off-time
- * just changed.
- */
-
- if (entryPtr->flags & GOT_FOCUS) {
- EntryFocusProc(entryPtr, 1);
- }
-
- /*
- * Claim the selection if we've suddenly started exporting it.
- */
-
- if (entryPtr->exportSelection && (!oldExport)
- && (entryPtr->selectFirst != -1)
- && !(entryPtr->flags & GOT_SELECTION)) {
- Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
- (ClientData) entryPtr);
- entryPtr->flags |= GOT_SELECTION;
- }
-
- /*
- * Recompute the window's geometry and arrange for it to be
- * redisplayed.
- */
-
- Tk_SetInternalBorder(entryPtr->tkwin,
- entryPtr->borderWidth + entryPtr->highlightWidth);
- if (entryPtr->highlightWidth <= 0) {
- entryPtr->highlightWidth = 0;
- }
- entryPtr->inset = entryPtr->highlightWidth + entryPtr->borderWidth + XPAD;
-
- EntryWorldChanged((ClientData) entryPtr);
- return TCL_OK;
}
/*
@@ -997,7 +1257,7 @@ EntryWorldChanged(instanceData)
ClientData instanceData; /* Information about widget. */
{
XGCValues gcValues;
- GC gc;
+ GC gc = None;
unsigned long mask;
Entry *entryPtr;
@@ -1008,12 +1268,15 @@ EntryWorldChanged(instanceData)
entryPtr->avgWidth = 1;
}
+ if (entryPtr->normalBorder != NULL) {
+ Tk_SetBackgroundFromBorder(entryPtr->tkwin, entryPtr->normalBorder);
+ }
+
gcValues.foreground = entryPtr->fgColorPtr->pixel;
gcValues.font = Tk_FontId(entryPtr->tkfont);
gcValues.graphics_exposures = False;
mask = GCForeground | GCFont | GCGraphicsExposures;
- gc = Tk_GetGCColor(entryPtr->tkwin, mask, &gcValues, entryPtr->fgColorPtr,
- NULL);
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
if (entryPtr->textGC != None) {
Tk_FreeGC(entryPtr->display, entryPtr->textGC);
}
@@ -1022,8 +1285,7 @@ EntryWorldChanged(instanceData)
gcValues.foreground = entryPtr->selFgColorPtr->pixel;
gcValues.font = Tk_FontId(entryPtr->tkfont);
mask = GCForeground | GCFont;
- gc = Tk_GetGCColor(entryPtr->tkwin, mask, &gcValues,
- entryPtr->selFgColorPtr, NULL);
+ gc = Tk_GetGC(entryPtr->tkwin, mask, &gcValues);
if (entryPtr->selTextGC != None) {
Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
}
@@ -1059,9 +1321,9 @@ static void
DisplayEntry(clientData)
ClientData clientData; /* Information about window. */
{
- register Entry *entryPtr = (Entry *) clientData;
- register Tk_Window tkwin = entryPtr->tkwin;
- int baseY, selStartX, selEndX, cursorX, x, w;
+ Entry *entryPtr = (Entry *) clientData;
+ Tk_Window tkwin = entryPtr->tkwin;
+ int baseY, selStartX, selEndX, cursorX;
int xBound;
Tk_FontMetrics fm;
Pixmap pixmap;
@@ -1119,19 +1381,21 @@ DisplayEntry(clientData)
*/
Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
- 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
- if (showSelection && (entryPtr->selectLast > entryPtr->leftIndex)) {
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ if (showSelection
+ && (entryPtr->selectLast > entryPtr->leftIndex)) {
if (entryPtr->selectFirst <= entryPtr->leftIndex) {
selStartX = entryPtr->leftX;
} else {
Tk_CharBbox(entryPtr->textLayout, entryPtr->selectFirst,
- &x, NULL, NULL, NULL);
- selStartX = x + entryPtr->layoutX;
+ &selStartX, NULL, NULL, NULL);
+ selStartX += entryPtr->layoutX;
}
if ((selStartX - entryPtr->selBorderWidth) < xBound) {
- Tk_CharBbox(entryPtr->textLayout, entryPtr->selectLast - 1,
- &x, NULL, &w, NULL);
- selEndX = x + w + entryPtr->layoutX;
+ 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,
@@ -1151,33 +1415,22 @@ DisplayEntry(clientData)
*/
if ((entryPtr->insertPos >= entryPtr->leftIndex)
- && (entryPtr->state == tkNormalUid)
+ && (entryPtr->state == STATE_NORMAL)
&& (entryPtr->flags & GOT_FOCUS)) {
- if (entryPtr->insertPos == 0) {
- cursorX = 0;
- } else if (entryPtr->insertPos >= entryPtr->numChars) {
- int idx = entryPtr->numChars >= 1 ? entryPtr->numChars - 1 : 0;
- Tk_CharBbox(entryPtr->textLayout, idx,
- &x, NULL, &w, NULL);
- cursorX = x + w;
- } else {
- Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos,
- &x, NULL, NULL, NULL);
- cursorX = x;
- }
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->insertPos, &cursorX, NULL,
+ NULL, NULL);
cursorX += entryPtr->layoutX;
cursorX -= (entryPtr->insertWidth)/2;
if (cursorX < xBound) {
if (entryPtr->flags & CURSOR_ON) {
Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->insertBorder,
- cursorX, baseY - fm.ascent,
- entryPtr->insertWidth, fm.ascent + fm.descent,
- entryPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ cursorX, baseY - fm.ascent, entryPtr->insertWidth,
+ fm.ascent + fm.descent, entryPtr->insertBorderWidth,
+ TK_RELIEF_RAISED);
} else if (entryPtr->insertBorder == entryPtr->selBorder) {
Tk_Fill3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
- cursorX, baseY - fm.ascent,
- entryPtr->insertWidth, fm.ascent + fm.descent,
- 0, TK_RELIEF_FLAT);
+ cursorX, baseY - fm.ascent, entryPtr->insertWidth,
+ fm.ascent + fm.descent, 0, TK_RELIEF_FLAT);
}
}
}
@@ -1191,18 +1444,19 @@ DisplayEntry(clientData)
entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
entryPtr->leftIndex, entryPtr->numChars);
- if (showSelection && (entryPtr->selTextGC != entryPtr->textGC) &&
- (entryPtr->selectFirst < entryPtr->selectLast)) {
- int first;
+ if (showSelection
+ && (entryPtr->selTextGC != entryPtr->textGC)
+ && (entryPtr->selectFirst < entryPtr->selectLast)) {
+ int selFirst;
- if (entryPtr->selectFirst - entryPtr->leftIndex < 0) {
- first = entryPtr->leftIndex;
+ if (entryPtr->selectFirst < entryPtr->leftIndex) {
+ selFirst = entryPtr->leftIndex;
} else {
- first = entryPtr->selectFirst;
+ selFirst = entryPtr->selectFirst;
}
Tk_DrawTextLayout(entryPtr->display, pixmap, entryPtr->selTextGC,
entryPtr->textLayout, entryPtr->layoutX, entryPtr->layoutY,
- first, entryPtr->selectLast);
+ selFirst, entryPtr->selectLast);
}
/*
@@ -1213,19 +1467,22 @@ DisplayEntry(clientData)
if (entryPtr->relief != TK_RELIEF_FLAT) {
Tk_Draw3DRectangle(tkwin, pixmap, entryPtr->normalBorder,
entryPtr->highlightWidth, entryPtr->highlightWidth,
- Tk_Width(tkwin) - 2*entryPtr->highlightWidth,
- Tk_Height(tkwin) - 2*entryPtr->highlightWidth,
+ Tk_Width(tkwin) - 2 * entryPtr->highlightWidth,
+ Tk_Height(tkwin) - 2 * entryPtr->highlightWidth,
entryPtr->borderWidth, entryPtr->relief);
}
if (entryPtr->highlightWidth != 0) {
- GC gc;
+ GC fgGC, bgGC;
+ bgGC = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
if (entryPtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
+ fgGC = Tk_GCForColor(entryPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ entryPtr->highlightWidth, pixmap);
} else {
- gc = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ entryPtr->highlightWidth, pixmap);
}
- Tk_DrawFocusHighlight(tkwin, gc, entryPtr->highlightWidth, pixmap);
}
/*
@@ -1262,38 +1519,53 @@ DisplayEntry(clientData)
static void
EntryComputeGeometry(entryPtr)
- Entry *entryPtr; /* Widget record for entry. */
+ Entry *entryPtr; /* Widget record for entry. */
{
int totalLength, overflow, maxOffScreen, rightX;
int height, width, i;
Tk_FontMetrics fm;
- char *p, *displayString;
+ char *p;
+
+ if (entryPtr->displayString != entryPtr->string) {
+ ckfree(entryPtr->displayString);
+ entryPtr->displayString = entryPtr->string;
+ entryPtr->numDisplayBytes = entryPtr->numBytes;
+ }
/*
* If we're displaying a special character instead of the value of
* the entry, recompute the displayString.
*/
- if (entryPtr->displayString != NULL) {
- ckfree(entryPtr->displayString);
- entryPtr->displayString = NULL;
- }
if (entryPtr->showChar != NULL) {
- entryPtr->displayString = (char *) ckalloc((unsigned)
- (entryPtr->numChars + 1));
- for (p = entryPtr->displayString, i = entryPtr->numChars; i > 0;
- i--, p++) {
- *p = entryPtr->showChar[0];
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+ int size;
+
+ /*
+ * Normalize the special character so we can safely duplicate it
+ * in the display string. If we didn't do this, then two malformed
+ * characters might end up looking like one valid UTF character in
+ * the resulting string.
+ */
+
+ Tcl_UtfToUniChar(entryPtr->showChar, &ch);
+ size = Tcl_UniCharToUtf(ch, buf);
+
+ entryPtr->numDisplayBytes = entryPtr->numChars * size;
+ entryPtr->displayString =
+ (char *) ckalloc((unsigned) (entryPtr->numDisplayBytes + 1));
+
+ p = entryPtr->displayString;
+ for (i = entryPtr->numChars; --i >= 0; ) {
+ p += Tcl_UniCharToUtf(ch, p);
}
- *p = 0;
- displayString = entryPtr->displayString;
- } else {
- displayString = entryPtr->string;
+ *p = '\0';
}
Tk_FreeTextLayout(entryPtr->textLayout);
entryPtr->textLayout = Tk_ComputeTextLayout(entryPtr->tkfont,
- displayString, entryPtr->numChars, 0, entryPtr->justify,
- TK_IGNORE_NEWLINES, &totalLength, &height);
+ entryPtr->displayString, entryPtr->numChars, 0,
+ entryPtr->justify, TK_IGNORE_NEWLINES, &totalLength, &height);
entryPtr->layoutY = (Tk_Height(entryPtr->tkwin) - height) / 2;
@@ -1328,13 +1600,13 @@ EntryComputeGeometry(entryPtr)
Tk_CharBbox(entryPtr->textLayout, maxOffScreen,
&rightX, NULL, NULL, NULL);
if (rightX < overflow) {
- maxOffScreen += 1;
+ maxOffScreen++;
}
if (entryPtr->leftIndex > maxOffScreen) {
entryPtr->leftIndex = maxOffScreen;
}
- Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex,
- &rightX, NULL, NULL, NULL);
+ Tk_CharBbox(entryPtr->textLayout, entryPtr->leftIndex, &rightX,
+ NULL, NULL, NULL);
entryPtr->leftX = entryPtr->inset;
entryPtr->layoutX = entryPtr->leftX - rightX;
}
@@ -1371,28 +1643,59 @@ EntryComputeGeometry(entryPtr)
*/
static void
-InsertChars(entryPtr, index, string)
- register Entry *entryPtr; /* Entry that is to get the new
- * elements. */
+InsertChars(entryPtr, index, value)
+ Entry *entryPtr; /* Entry that is to get the new elements. */
int index; /* Add the new elements before this
- * element. */
- char *string; /* New characters to add (NULL-terminated
+ * character index. */
+ char *value; /* New characters to add (NULL-terminated
* string). */
{
- int length;
- char *new;
+ int byteIndex, byteCount, oldChars, charsAdded, newByteCount;
+ char *new, *string;
- length = strlen(string);
- if (length == 0) {
+ string = entryPtr->string;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = strlen(value);
+ if (byteCount == 0) {
return;
}
- new = (char *) ckalloc((unsigned) (entryPtr->numChars + length + 1));
- strncpy(new, entryPtr->string, (size_t) index);
- strcpy(new+index, string);
- strcpy(new+index+length, entryPtr->string+index);
- ckfree(entryPtr->string);
+
+ 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(string);
entryPtr->string = new;
- entryPtr->numChars += length;
+
+ /*
+ * 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.
@@ -1403,19 +1706,20 @@ InsertChars(entryPtr, index, string)
*/
if (entryPtr->selectFirst >= index) {
- entryPtr->selectFirst += length;
+ entryPtr->selectFirst += charsAdded;
}
if (entryPtr->selectLast > index) {
- entryPtr->selectLast += length;
+ entryPtr->selectLast += charsAdded;
}
- if ((entryPtr->selectAnchor > index) || (entryPtr->selectFirst >= index)) {
- entryPtr->selectAnchor += length;
+ if ((entryPtr->selectAnchor > index)
+ || (entryPtr->selectFirst >= index)) {
+ entryPtr->selectAnchor += charsAdded;
}
if (entryPtr->leftIndex > index) {
- entryPtr->leftIndex += length;
+ entryPtr->leftIndex += charsAdded;
}
if (entryPtr->insertPos >= index) {
- entryPtr->insertPos += length;
+ entryPtr->insertPos += charsAdded;
}
EntryValueChanged(entryPtr);
}
@@ -1439,11 +1743,12 @@ InsertChars(entryPtr, index, string)
static void
DeleteChars(entryPtr, index, count)
- register Entry *entryPtr; /* Entry widget to modify. */
+ Entry *entryPtr; /* Entry widget to modify. */
int index; /* Index of first character to delete. */
int count; /* How many characters to delete. */
{
- char *new;
+ int byteIndex, byteCount, newByteCount;
+ char *new, *string, *todelete;
if ((index + count) > entryPtr->numChars) {
count = entryPtr->numChars - index;
@@ -1452,12 +1757,38 @@ DeleteChars(entryPtr, index, count)
return;
}
- new = (char *) ckalloc((unsigned) (entryPtr->numChars + 1 - count));
- strncpy(new, entryPtr->string, (size_t) index);
- strcpy(new+index, entryPtr->string+index+count);
+ 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(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
@@ -1466,21 +1797,22 @@ DeleteChars(entryPtr, index, count)
*/
if (entryPtr->selectFirst >= index) {
- if (entryPtr->selectFirst >= (index+count)) {
+ if (entryPtr->selectFirst >= (index + count)) {
entryPtr->selectFirst -= count;
} else {
entryPtr->selectFirst = index;
}
}
if (entryPtr->selectLast >= index) {
- if (entryPtr->selectLast >= (index+count)) {
+ if (entryPtr->selectLast >= (index + count)) {
entryPtr->selectLast -= count;
} else {
entryPtr->selectLast = index;
}
}
if (entryPtr->selectLast <= entryPtr->selectFirst) {
- entryPtr->selectFirst = entryPtr->selectLast = -1;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
}
if (entryPtr->selectAnchor >= index) {
if (entryPtr->selectAnchor >= (index+count)) {
@@ -1490,14 +1822,14 @@ DeleteChars(entryPtr, index, count)
}
}
if (entryPtr->leftIndex > index) {
- if (entryPtr->leftIndex >= (index+count)) {
+ if (entryPtr->leftIndex >= (index + count)) {
entryPtr->leftIndex -= count;
} else {
entryPtr->leftIndex = index;
}
}
if (entryPtr->insertPos >= index) {
- if (entryPtr->insertPos >= (index+count)) {
+ if (entryPtr->insertPos >= (index + count)) {
entryPtr->insertPos -= count;
} else {
entryPtr->insertPos = index;
@@ -1583,24 +1915,74 @@ EntryValueChanged(entryPtr)
static void
EntrySetValue(entryPtr, value)
- register Entry *entryPtr; /* Entry whose value is to be
- * changed. */
- char *value; /* New text to display in entry. */
+ Entry *entryPtr; /* Entry whose value is to be changed. */
+ char *value; /* New text to display in entry. */
{
+ 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
+ */
+ oldSource = (char *) ckalloc((unsigned) (valueLen + 1));
+ strcpy(oldSource, value);
+ value = oldSource;
+ 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(value);
+ return;
+ }
+ }
+
+ oldSource = entryPtr->string;
ckfree(entryPtr->string);
- entryPtr->numChars = strlen(value);
- entryPtr->string = (char *) ckalloc((unsigned) (entryPtr->numChars + 1));
- strcpy(entryPtr->string, value);
- if (entryPtr->selectFirst != -1) {
+
+ if (malloced) {
+ entryPtr->string = value;
+ } else {
+ entryPtr->string = (char *) ckalloc((unsigned) (valueLen + 1));
+ strcpy(entryPtr->string, value);
+ }
+ 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 = entryPtr->selectLast = -1;
+ entryPtr->selectFirst = -1;
+ entryPtr->selectLast = -1;
} else if (entryPtr->selectLast > entryPtr->numChars) {
entryPtr->selectLast = entryPtr->numChars;
}
}
if (entryPtr->leftIndex >= entryPtr->numChars) {
- entryPtr->leftIndex = entryPtr->numChars-1;
- if (entryPtr->leftIndex < 0) {
+ if (entryPtr->numChars > 0) {
+ entryPtr->leftIndex = entryPtr->numChars - 1;
+ } else {
entryPtr->leftIndex = 0;
}
}
@@ -1641,14 +2023,7 @@ EntryEventProc(clientData, eventPtr)
EventuallyRedraw(entryPtr);
entryPtr->flags |= BORDER_NEEDED;
} else if (eventPtr->type == DestroyNotify) {
- if (entryPtr->tkwin != NULL) {
- entryPtr->tkwin = NULL;
- Tcl_DeleteCommandFromToken(entryPtr->interp, entryPtr->widgetCmd);
- }
- if (entryPtr->flags & REDRAW_PENDING) {
- Tcl_CancelIdleCall(DisplayEntry, (ClientData) entryPtr);
- }
- Tcl_EventuallyFree((ClientData) entryPtr, DestroyEntry);
+ DestroyEntry((char *) clientData);
} else if (eventPtr->type == ConfigureNotify) {
Tcl_Preserve((ClientData) entryPtr);
entryPtr->flags |= UPDATE_SCROLLBAR;
@@ -1689,7 +2064,6 @@ EntryCmdDeletedProc(clientData)
ClientData clientData; /* Pointer to widget record for widget. */
{
Entry *entryPtr = (Entry *) clientData;
- Tk_Window tkwin = entryPtr->tkwin;
/*
* This procedure could be invoked either because the window was
@@ -1698,14 +2072,13 @@ EntryCmdDeletedProc(clientData)
* destroys the widget.
*/
- if (tkwin != NULL) {
- entryPtr->tkwin = NULL;
- Tk_DestroyWindow(tkwin);
+ if (!(entryPtr->flags & ENTRY_DELETED)) {
+ Tk_DestroyWindow(entryPtr->tkwin);
}
}
/*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* GetEntryIndex --
*
@@ -1714,15 +2087,15 @@ EntryCmdDeletedProc(clientData)
*
* Results:
* A standard Tcl result. If all went well, then *indexPtr is
- * filled in with the index (into entryPtr) corresponding to
+ * 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 interp->result.
+ * error occurs then an error message is left in the interp's result.
*
* Side effects:
* None.
*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
static int
@@ -1731,7 +2104,8 @@ GetEntryIndex(interp, entryPtr, string, indexPtr)
Entry *entryPtr; /* Entry for which the index is being
* specified. */
char *string; /* Specifies character in entryPtr. */
- int *indexPtr; /* Where to store converted index. */
+ int *indexPtr; /* Where to store converted character
+ * index. */
{
size_t length;
@@ -1744,7 +2118,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr)
badIndex:
/*
- * Some of the paths here leave messages in interp->result,
+ * Some of the paths here leave messages in the interp's result,
* so we have to clear it out before storing our own message.
*/
@@ -1766,8 +2140,8 @@ GetEntryIndex(interp, entryPtr, string, indexPtr)
goto badIndex;
}
} else if (string[0] == 's') {
- if (entryPtr->selectFirst == -1) {
- interp->result = "selection isn't in entry";
+ if (entryPtr->selectFirst < 0) {
+ Tcl_SetResult(interp, "selection isn't in entry", TCL_STATIC);
return TCL_ERROR;
}
if (length < 5) {
@@ -1783,7 +2157,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr)
} else if (string[0] == '@') {
int x, roundUp;
- if (Tcl_GetInt(interp, string+1, &x) != TCL_OK) {
+ if (Tcl_GetInt(interp, string + 1, &x) != TCL_OK) {
goto badIndex;
}
if (x < entryPtr->inset) {
@@ -1815,7 +2189,7 @@ GetEntryIndex(interp, entryPtr, string, indexPtr)
*indexPtr = 0;
} else if (*indexPtr > entryPtr->numChars) {
*indexPtr = entryPtr->numChars;
- }
+ }
}
if(*indexPtr > entryPtr->numChars)
*indexPtr = entryPtr->numChars;
@@ -1841,9 +2215,8 @@ GetEntryIndex(interp, entryPtr, string, indexPtr)
static void
EntryScanTo(entryPtr, x)
- register Entry *entryPtr; /* Information about widget. */
- int x; /* X-coordinate to use for scan
- * operation. */
+ Entry *entryPtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan operation. */
{
int newLeftIndex;
@@ -1859,19 +2232,24 @@ EntryScanTo(entryPtr, x)
*/
newLeftIndex = entryPtr->scanMarkIndex
- - (10*(x - entryPtr->scanMarkX))/entryPtr->avgWidth;
+ - (10 * (x - entryPtr->scanMarkX)) / entryPtr->avgWidth;
if (newLeftIndex >= entryPtr->numChars) {
- newLeftIndex = entryPtr->scanMarkIndex = entryPtr->numChars-1;
+ 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);
}
}
@@ -1895,10 +2273,9 @@ EntryScanTo(entryPtr, x)
static void
EntrySelectTo(entryPtr, index)
- register Entry *entryPtr; /* Information about widget. */
- int index; /* Index of element that is to
- * become the "other" end of the
- * selection. */
+ Entry *entryPtr; /* Information about widget. */
+ int index; /* Character index of element that is to
+ * become the "other" end of the selection. */
{
int newFirst, newLast;
@@ -1961,38 +2338,35 @@ EntrySelectTo(entryPtr, index)
static int
EntryFetchSelection(clientData, offset, buffer, maxBytes)
- ClientData clientData; /* Information about entry widget. */
- int offset; /* Offset within selection of first
- * character to be returned. */
- char *buffer; /* Location in which to place
- * selection. */
- int maxBytes; /* Maximum number of bytes to place
- * at buffer, not including terminating
- * NULL character. */
+ 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 count;
- char *displayString;
+ int byteCount;
+ char *string, *selStart, *selEnd;
if ((entryPtr->selectFirst < 0) || !(entryPtr->exportSelection)) {
return -1;
}
- count = entryPtr->selectLast - entryPtr->selectFirst - offset;
- if (count > maxBytes) {
- count = maxBytes;
+ 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 (count <= 0) {
+ if (byteCount <= 0) {
return 0;
}
- if (entryPtr->displayString == NULL) {
- displayString = entryPtr->string;
- } else {
- displayString = entryPtr->displayString;
- }
- strncpy(buffer, displayString + entryPtr->selectFirst + offset,
- (size_t) count);
- buffer[count] = '\0';
- return count;
+ memcpy(buffer, selStart + offset, (size_t) byteCount);
+ buffer[byteCount] = '\0';
+ return byteCount;
}
/*
@@ -2015,7 +2389,7 @@ EntryFetchSelection(clientData, offset, buffer, maxBytes)
static void
EntryLostSelection(clientData)
- ClientData clientData; /* Information about entry widget. */
+ ClientData clientData; /* Information about entry widget. */
{
Entry *entryPtr = (Entry *) clientData;
@@ -2028,7 +2402,7 @@ EntryLostSelection(clientData)
*/
#ifdef ALWAYS_SHOW_SELECTION
- if ((entryPtr->selectFirst != -1) && entryPtr->exportSelection) {
+ if ((entryPtr->selectFirst >= 0) && entryPtr->exportSelection) {
entryPtr->selectFirst = -1;
entryPtr->selectLast = -1;
EventuallyRedraw(entryPtr);
@@ -2057,7 +2431,7 @@ EntryLostSelection(clientData)
static void
EventuallyRedraw(entryPtr)
- register Entry *entryPtr; /* Information about widget. */
+ Entry *entryPtr; /* Information about widget. */
{
if ((entryPtr->tkwin == NULL) || !Tk_IsMapped(entryPtr->tkwin)) {
return;
@@ -2096,11 +2470,11 @@ EventuallyRedraw(entryPtr)
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. */
+ 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;
@@ -2110,22 +2484,18 @@ EntryVisibleRange(entryPtr, firstPtr, lastPtr)
} else {
charsInWindow = Tk_PointToChar(entryPtr->textLayout,
Tk_Width(entryPtr->tkwin) - entryPtr->inset
- - entryPtr->layoutX - 1, 0) + 1;
- if (charsInWindow > entryPtr->numChars) {
- /*
- * If all chars were visible, then charsInWindow will be
- * the index just after the last char that was visible.
- */
-
- charsInWindow = entryPtr->numChars;
+ - 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;
+
+ *firstPtr = (double) entryPtr->leftIndex / entryPtr->numChars;
+ *lastPtr = (double) (entryPtr->leftIndex + charsInWindow)
+ / entryPtr->numChars;
}
}
@@ -2153,7 +2523,7 @@ static void
EntryUpdateScrollbar(entryPtr)
Entry *entryPtr; /* Information about widget. */
{
- char args[100];
+ char args[TCL_DOUBLE_SPACE * 2];
int code;
double first, last;
Tcl_Interp *interp;
@@ -2198,9 +2568,10 @@ static void
EntryBlinkProc(clientData)
ClientData clientData; /* Pointer to record describing entry. */
{
- register Entry *entryPtr = (Entry *) clientData;
+ Entry *entryPtr = (Entry *) clientData;
- if (!(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
+ if ((entryPtr->state == STATE_DISABLED) ||
+ !(entryPtr->flags & GOT_FOCUS) || (entryPtr->insertOffTime == 0)) {
return;
}
if (entryPtr->flags & CURSOR_ON) {
@@ -2235,7 +2606,7 @@ EntryBlinkProc(clientData)
static void
EntryFocusProc(entryPtr, gotFocus)
- register Entry *entryPtr; /* Entry that got or lost focus. */
+ Entry *entryPtr; /* Entry that got or lost focus. */
int gotFocus; /* 1 means window is getting focus, 0 means
* it's losing it. */
{
@@ -2247,9 +2618,21 @@ EntryFocusProc(entryPtr, gotFocus)
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);
}
@@ -2281,7 +2664,7 @@ EntryTextVarProc(clientData, interp, name1, name2, flags)
char *name2; /* Not used. */
int flags; /* Information about what happened. */
{
- register Entry *entryPtr = (Entry *) clientData;
+ Entry *entryPtr = (Entry *) clientData;
char *value;
/*
@@ -2311,8 +2694,308 @@ EntryTextVarProc(clientData, interp, name1, name2, flags)
if (value == NULL) {
value = "";
}
- if (strcmp(value, entryPtr->string) != 0) {
- EntrySetValue(entryPtr, 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);
+
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp,
+ "\n\t(in validation command executed by entry)");
+ Tcl_BackgroundError(interp);
+ return TCL_ERROR;
+ }
+
+ 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). */
+ 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;
+ }
+ /*
+ * 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);
+ }
+ }
+
+ 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 char *before; /* Command containing percent
+ * expressions to be replaced. */
+ char *change; /* Characters to added/deleted
+ * (NULL-terminated string). */
+ 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 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 = '%';
+ }
+ 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 entry */
+ 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);
+ }
+}
+
diff --git a/tk/generic/tkError.c b/tk/generic/tkError.c
index 77909331a6f..aaf7c10b351 100644
--- a/tk/generic/tkError.c
+++ b/tk/generic/tkError.c
@@ -305,3 +305,4 @@ ErrorProc(display, errEventPtr)
couldntHandle:
return (*defaultHandler)(display, errEventPtr);
}
+
diff --git a/tk/generic/tkEvent.c b/tk/generic/tkEvent.c
index 2d10dccc69c..bd70e881bae 100644
--- a/tk/generic/tkEvent.c
+++ b/tk/generic/tkEvent.c
@@ -39,10 +39,6 @@ typedef struct InProgress {
struct InProgress *nextPtr; /* Next higher nested search. */
} InProgress;
-static InProgress *pendingPtr = NULL;
- /* Topmost search in progress, or
- * NULL if none. */
-
/*
* For each call to Tk_CreateGenericHandler, an instance of the following
* structure will be created. All of the active handlers are linked into a
@@ -58,11 +54,6 @@ typedef struct GenericHandler {
* handlers, or NULL for end of list. */
} GenericHandler;
-static GenericHandler *genericList = NULL;
- /* First handler in the list, or NULL. */
-static GenericHandler *lastGenericPtr = NULL;
- /* Last handler in list. */
-
/*
* There's a potential problem if Tk_HandleEvent is entered recursively.
* A handler cannot be deleted physically until we have returned from
@@ -70,11 +61,8 @@ static GenericHandler *lastGenericPtr = NULL;
* its `next' entry. We deal with the problem by using the `delete flag' and
* deleting handlers only when it's known that there's no handler active.
*
- * The following variable has a non-zero value when a handler is active.
*/
-static int genericHandlersActive = 0;
-
/*
* The following structure is used for queueing X-style events on the
* Tcl event queue.
@@ -134,15 +122,37 @@ static unsigned long eventMasks[TK_LASTEVENT] = {
MouseWheelMask /* MouseWheelEvent */
};
+
/*
- * If someone has called Tk_RestrictEvents, the information below
- * keeps track of it.
+ * 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.
*/
-static Tk_RestrictProc *restrictProc;
+typedef struct ThreadSpecificData {
+
+ int genericHandlersActive;
+ /* The following variable has a non-zero
+ * value when a handler is active. */
+ InProgress *pendingPtr;
+ /* Topmost search in progress, or
+ * NULL if none. */
+ GenericHandler *genericList;
+ /* First handler in the list, or NULL. */
+ GenericHandler *lastGenericPtr;
+ /* Last handler in list. */
+
+ /*
+ * If someone has called Tk_RestrictEvents, the information below
+ * keeps track of it.
+ */
+
+ Tk_RestrictProc *restrictProc;
/* Procedure to call. NULL means no
* restrictProc is currently in effect. */
-static ClientData restrictArg; /* Argument to pass to restrictProc. */
+ ClientData restrictArg; /* Argument to pass to restrictProc. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* Prototypes for procedures that are only referenced locally within
@@ -266,6 +276,8 @@ Tk_DeleteEventHandler(token, mask, proc, clientData)
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
@@ -288,7 +300,7 @@ Tk_DeleteEventHandler(token, mask, proc, clientData)
* process the next one instead.
*/
- for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
if (ipPtr->nextHandler == handlerPtr) {
ipPtr->nextHandler = handlerPtr->nextPtr;
}
@@ -337,6 +349,8 @@ Tk_CreateGenericHandler(proc, clientData)
ClientData clientData; /* One-word value to pass to proc. */
{
GenericHandler *handlerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
handlerPtr = (GenericHandler *) ckalloc (sizeof (GenericHandler));
@@ -344,12 +358,12 @@ Tk_CreateGenericHandler(proc, clientData)
handlerPtr->clientData = clientData;
handlerPtr->deleteFlag = 0;
handlerPtr->nextPtr = NULL;
- if (genericList == NULL) {
- genericList = handlerPtr;
+ if (tsdPtr->genericList == NULL) {
+ tsdPtr->genericList = handlerPtr;
} else {
- lastGenericPtr->nextPtr = handlerPtr;
+ tsdPtr->lastGenericPtr->nextPtr = handlerPtr;
}
- lastGenericPtr = handlerPtr;
+ tsdPtr->lastGenericPtr = handlerPtr;
}
/*
@@ -377,8 +391,10 @@ Tk_DeleteGenericHandler(proc, clientData)
ClientData clientData;
{
GenericHandler * handler;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (handler = genericList; handler; handler = handler->nextPtr) {
+ for (handler = tsdPtr->genericList; handler; handler = handler->nextPtr) {
if ((handler->proc == proc) && (handler->clientData == clientData)) {
handler->deleteFlag = 1;
}
@@ -388,6 +404,39 @@ Tk_DeleteGenericHandler(proc, clientData)
/*
*--------------------------------------------------------------
*
+ * 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->genericHandlersActive = 0;
+ tsdPtr->pendingPtr = NULL;
+ tsdPtr->genericList = NULL;
+ tsdPtr->lastGenericPtr = NULL;
+ tsdPtr->restrictProc = NULL;
+ tsdPtr->restrictArg = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
* Tk_HandleEvent --
*
* Given an event, invoke all the handlers that have
@@ -415,6 +464,35 @@ Tk_HandleEvent(eventPtr)
Window handlerWindow;
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
@@ -422,9 +500,10 @@ Tk_HandleEvent(eventPtr)
* an event is fully processed, go no further.
*/
- for (genPrevPtr = NULL, genericPtr = genericList; genericPtr != NULL; ) {
+ for (genPrevPtr = NULL, genericPtr = tsdPtr->genericList;
+ genericPtr != NULL; ) {
if (genericPtr->deleteFlag) {
- if (!genericHandlersActive) {
+ if (!tsdPtr->genericHandlersActive) {
GenericHandler *tmpPtr;
/*
@@ -435,12 +514,12 @@ Tk_HandleEvent(eventPtr)
tmpPtr = genericPtr->nextPtr;
if (genPrevPtr == NULL) {
- genericList = tmpPtr;
+ tsdPtr->genericList = tmpPtr;
} else {
genPrevPtr->nextPtr = tmpPtr;
}
if (tmpPtr == NULL) {
- lastGenericPtr = genPrevPtr;
+ tsdPtr->lastGenericPtr = genPrevPtr;
}
(void) ckfree((char *) genericPtr);
genericPtr = tmpPtr;
@@ -449,9 +528,9 @@ Tk_HandleEvent(eventPtr)
} else {
int done;
- genericHandlersActive++;
+ tsdPtr->genericHandlersActive++;
done = (*genericPtr->proc)(genericPtr->clientData, eventPtr);
- genericHandlersActive--;
+ tsdPtr->genericHandlersActive--;
if (done) {
return;
}
@@ -590,19 +669,20 @@ Tk_HandleEvent(eventPtr)
* input context for the window if it hasn't already been done
* (XFilterEvent needs this context).
*/
-
- if (!(winPtr->flags & TK_CHECKED_IC)) {
- if (winPtr->dispPtr->inputMethod != NULL) {
- winPtr->inputContext = XCreateIC(
+ if (winPtr->dispPtr->useInputMethods) {
+ if (!(winPtr->flags & TK_CHECKED_IC)) {
+ if (winPtr->dispPtr->inputMethod != NULL) {
+ winPtr->inputContext = XCreateIC(
winPtr->dispPtr->inputMethod, XNInputStyle,
XIMPreeditNothing|XIMStatusNothing,
XNClientWindow, winPtr->window,
XNFocusWindow, winPtr->window, NULL);
+ }
+ winPtr->flags |= TK_CHECKED_IC;
+ }
+ if (XFilterEvent(eventPtr, None)) {
+ goto done;
}
- winPtr->flags |= TK_CHECKED_IC;
- }
- if (XFilterEvent(eventPtr, None)) {
- goto done;
}
#endif /* TK_USE_INPUT_METHODS */
@@ -623,8 +703,8 @@ Tk_HandleEvent(eventPtr)
ip.eventPtr = eventPtr;
ip.winPtr = winPtr;
ip.nextHandler = NULL;
- ip.nextPtr = pendingPtr;
- pendingPtr = &ip;
+ ip.nextPtr = tsdPtr->pendingPtr;
+ tsdPtr->pendingPtr = &ip;
if (mask == 0) {
if ((eventPtr->type == SelectionClear)
|| (eventPtr->type == SelectionRequest)
@@ -657,7 +737,7 @@ Tk_HandleEvent(eventPtr)
TkBindEventProc(winPtr, eventPtr);
}
}
- pendingPtr = ip.nextPtr;
+ tsdPtr->pendingPtr = ip.nextPtr;
done:
/*
@@ -695,6 +775,8 @@ TkEventDeadWindow(winPtr)
{
register TkEventHandler *handlerPtr;
register InProgress *ipPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* While deleting all the handlers, be careful to check for
@@ -706,7 +788,8 @@ TkEventDeadWindow(winPtr)
while (winPtr->handlerList != NULL) {
handlerPtr = winPtr->handlerList;
winPtr->handlerList = handlerPtr->nextPtr;
- for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
if (ipPtr->nextHandler == handlerPtr) {
ipPtr->nextHandler = NULL;
}
@@ -744,11 +827,13 @@ TkCurrentTime(dispPtr)
TkDisplay *dispPtr; /* Display for which the time is desired. */
{
register XEvent *eventPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (pendingPtr == NULL) {
+ if (tsdPtr->pendingPtr == NULL) {
return dispPtr->lastEventTime;
}
- eventPtr = pendingPtr->eventPtr;
+ eventPtr = tsdPtr->pendingPtr->eventPtr;
switch (eventPtr->type) {
case ButtonPress:
case ButtonRelease:
@@ -798,11 +883,13 @@ Tk_RestrictEvents(proc, arg, prevArgPtr)
* argument. */
{
Tk_RestrictProc *prev;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- prev = restrictProc;
- *prevArgPtr = restrictArg;
- restrictProc = proc;
- restrictArg = arg;
+ prev = tsdPtr->restrictProc;
+ *prevArgPtr = tsdPtr->restrictArg;
+ tsdPtr->restrictProc = proc;
+ tsdPtr->restrictArg = arg;
return prev;
}
@@ -841,7 +928,7 @@ Tk_QueueWindowEvent(eventPtr, position)
* Find our display structure for the event's display.
*/
- for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
if (dispPtr == NULL) {
return;
}
@@ -962,12 +1049,14 @@ WindowEventProc(evPtr, flags)
{
TkWindowEvent *wevPtr = (TkWindowEvent *) evPtr;
Tk_RestrictAction result;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (!(flags & TCL_WINDOW_EVENTS)) {
return 0;
}
- if (restrictProc != NULL) {
- result = (*restrictProc)(restrictArg, &wevPtr->event);
+ if (tsdPtr->restrictProc != NULL) {
+ result = (*tsdPtr->restrictProc)(tsdPtr->restrictArg, &wevPtr->event);
if (result != TK_PROCESS_EVENT) {
if (result == TK_DEFER_EVENT) {
return 0;
@@ -1041,3 +1130,4 @@ Tk_MainLoop()
Tcl_DoOneEvent(0);
}
}
+
diff --git a/tk/generic/tkFileFilter.c b/tk/generic/tkFileFilter.c
index 258f6fdf604..7604746bf9f 100644
--- a/tk/generic/tkFileFilter.c
+++ b/tk/generic/tkFileFilter.c
@@ -10,7 +10,6 @@
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id$
- *
*/
#include "tkInt.h"
@@ -484,3 +483,4 @@ FreeMacFileTypes(clausePtr)
}
clausePtr->macTypes = NULL;
}
+
diff --git a/tk/generic/tkFileFilter.h b/tk/generic/tkFileFilter.h
index 1550d76b45b..ec4d43f9c76 100644
--- a/tk/generic/tkFileFilter.h
+++ b/tk/generic/tkFileFilter.h
@@ -90,3 +90,4 @@ EXTERN int TkGetFileFilters _ANSI_ARGS_ ((Tcl_Interp *interp,
# define TCL_STORAGE_CLASS DLLIMPORT
#endif
+
diff --git a/tk/generic/tkFocus.c b/tk/generic/tkFocus.c
index 4cd35ce9fe2..8ed77cbb309 100644
--- a/tk/generic/tkFocus.c
+++ b/tk/generic/tkFocus.c
@@ -76,12 +76,6 @@ typedef struct TkDisplayFocusInfo {
} DisplayFocusInfo;
/*
- * Global used for debugging.
- */
-
-int tclFocusDebug = 0;
-
-/*
* The following magic value is stored in the "send_event" field of
* FocusIn and FocusOut events that are generated in this file. This
* allows us to separate "real" events coming from the server from
@@ -101,12 +95,11 @@ static void FocusMapProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
static void GenerateFocusEvents _ANSI_ARGS_((TkWindow *sourcePtr,
TkWindow *destPtr));
-static void SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force));
/*
*--------------------------------------------------------------
*
- * Tk_FocusCmd --
+ * Tk_FocusObjCmd --
*
* This procedure is invoked to process the "focus" Tcl command.
* See the user documentation for details on what it does.
@@ -121,28 +114,30 @@ static void SetFocus _ANSI_ARGS_((TkWindow *winPtr, int force));
*/
int
-Tk_FocusCmd(clientData, interp, argc, argv)
+Tk_FocusObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ static char *focusOptions[] = {"-displayof", "-force", "-lastfor",
+ (char *) NULL};
Tk_Window tkwin = (Tk_Window) clientData;
TkWindow *winPtr = (TkWindow *) clientData;
TkWindow *newPtr, *focusWinPtr, *topLevelPtr;
ToplevelFocusInfo *tlFocusPtr;
- char c;
- size_t length;
+ char *windowName;
+ int index;
/*
* If invoked with no arguments, just return the current focus window.
*/
- if (argc == 1) {
+ if (objc == 1) {
focusWinPtr = TkGetFocusWin(winPtr);
if (focusWinPtr != NULL) {
- interp->result = focusWinPtr->pathName;
+ Tcl_SetResult(interp, focusWinPtr->pathName, TCL_STATIC);
}
return TCL_OK;
}
@@ -152,81 +147,94 @@ Tk_FocusCmd(clientData, interp, argc, argv)
* on that window.
*/
- if (argc == 2) {
- if (argv[1][0] == 0) {
+ 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 (argv[1][0] == '.') {
- newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (windowName[0] == '.') {
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
if (newPtr == NULL) {
return TCL_ERROR;
}
if (!(newPtr->flags & TK_ALREADY_DEAD)) {
- SetFocus(newPtr, 0);
+ TkSetFocusWin(newPtr, 0);
}
return TCL_OK;
}
}
- length = strlen(argv[1]);
- c = argv[1][1];
- if ((c == 'd') && (strncmp(argv[1], "-displayof", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " -displayof window\"", (char *) NULL);
- return TCL_ERROR;
- }
- newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
- if (newPtr == NULL) {
- return TCL_ERROR;
- }
- newPtr = TkGetFocusWin(newPtr);
- if (newPtr != NULL) {
- interp->result = newPtr->pathName;
- }
- } else if ((c == 'f') && (strncmp(argv[1], "-force", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " -force window\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (argv[2][0] == 0) {
- return TCL_OK;
- }
- newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
- if (newPtr == NULL) {
- return TCL_ERROR;
- }
- SetFocus(newPtr, 1);
- } else if ((c == 'l') && (strncmp(argv[1], "-lastfor", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " -lastfor window\"", (char *) NULL);
- return TCL_ERROR;
+ 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;
}
- newPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
- if (newPtr == NULL) {
- return TCL_ERROR;
+ 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;
}
- for (topLevelPtr = newPtr; topLevelPtr != NULL;
- topLevelPtr = topLevelPtr->parentPtr) {
- if (topLevelPtr->flags & TK_TOP_LEVEL) {
- for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
- tlFocusPtr != NULL;
- tlFocusPtr = tlFocusPtr->nextPtr) {
- if (tlFocusPtr->topLevelPtr == topLevelPtr) {
- interp->result = tlFocusPtr->focusWinPtr->pathName;
- return TCL_OK;
+ case 2: { /* -lastfor */
+ windowName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ newPtr = (TkWindow *) Tk_NameToWindow(interp, windowName, tkwin);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (topLevelPtr = newPtr; topLevelPtr != NULL;
+ topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr->flags & TK_TOP_LEVEL) {
+ for (tlFocusPtr = newPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ Tcl_SetResult(interp,
+ tlFocusPtr->focusWinPtr->pathName,
+ TCL_STATIC);
+ return TCL_OK;
+ }
}
+ Tcl_SetResult(interp, topLevelPtr->pathName, TCL_STATIC);
+ return TCL_OK;
}
- interp->result = topLevelPtr->pathName;
- return TCL_OK;
}
+ break;
+ }
+ default: {
+ panic("bad const entries to focusOptions in focus command");
}
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be -displayof, -force, or -lastfor", (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
}
@@ -300,7 +308,7 @@ TkFocusFilterEvent(winPtr, eventPtr)
if ((eventPtr->xfocus.mode == EMBEDDED_APP_WANTS_FOCUS)
&& (eventPtr->type == FocusIn)) {
- SetFocus(winPtr, eventPtr->xfocus.detail);
+ TkSetFocusWin(winPtr, eventPtr->xfocus.detail);
return 0;
}
@@ -479,7 +487,7 @@ TkFocusFilterEvent(winPtr, eventPtr)
if (eventPtr->xcrossing.focus &&
(displayFocusPtr->focusWinPtr == NULL)
&& !(winPtr->flags & TK_EMBEDDED)) {
- if (tclFocusDebug) {
+ if (dispPtr->focusDebug) {
printf("Focussed implicitly on %s\n",
newFocusPtr->pathName);
}
@@ -504,7 +512,7 @@ TkFocusFilterEvent(winPtr, eventPtr)
if ((dispPtr->implicitWinPtr != NULL)
&& !(winPtr->flags & TK_EMBEDDED)) {
- if (tclFocusDebug) {
+ if (dispPtr->focusDebug) {
printf("Defocussed implicit Async\n");
}
GenerateFocusEvents(displayFocusPtr->focusWinPtr,
@@ -521,7 +529,7 @@ TkFocusFilterEvent(winPtr, eventPtr)
/*
*----------------------------------------------------------------------
*
- * SetFocus --
+ * TkSetFocusWin --
*
* This procedure is invoked to change the focus window for a
* given display in a given application.
@@ -536,8 +544,8 @@ TkFocusFilterEvent(winPtr, eventPtr)
*----------------------------------------------------------------------
*/
-static void
-SetFocus(winPtr, force)
+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
@@ -550,8 +558,14 @@ SetFocus(winPtr, force)
int allMapped, serial;
displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
- /* CYGNUS LOCAL: We can't just return if force is set. */
- if (winPtr == displayFocusPtr->focusWinPtr && ! force) {
+
+ /*
+ * 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;
}
@@ -814,7 +828,7 @@ TkFocusDeadWindow(winPtr)
*/
if (dispPtr->implicitWinPtr == winPtr) {
- if (tclFocusDebug) {
+ if (dispPtr->focusDebug) {
printf("releasing focus to root after %s died\n",
tlFocusPtr->topLevelPtr->pathName);
}
@@ -842,7 +856,7 @@ TkFocusDeadWindow(winPtr)
tlFocusPtr->focusWinPtr = tlFocusPtr->topLevelPtr;
if ((displayFocusPtr->focusWinPtr == winPtr)
&& !(tlFocusPtr->topLevelPtr->flags & TK_ALREADY_DEAD)) {
- if (tclFocusDebug) {
+ if (dispPtr->focusDebug) {
printf("forwarding focus to %s after %s died\n",
tlFocusPtr->topLevelPtr->pathName,
winPtr->pathName);
@@ -937,14 +951,14 @@ FocusMapProc(clientData, eventPtr)
if (eventPtr->type == VisibilityNotify) {
displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr,
winPtr->dispPtr);
- if (tclFocusDebug) {
+ if (winPtr->dispPtr->focusDebug) {
printf("auto-focussing on %s, force %d\n", winPtr->pathName,
displayFocusPtr->forceFocus);
}
Tk_DeleteEventHandler((Tk_Window) winPtr, VisibilityChangeMask,
FocusMapProc, clientData);
displayFocusPtr->focusOnMapPtr = NULL;
- SetFocus(winPtr, displayFocusPtr->forceFocus);
+ TkSetFocusWin(winPtr, displayFocusPtr->forceFocus);
}
}
@@ -997,3 +1011,4 @@ FindDisplayFocusInfo(mainPtr, dispPtr)
mainPtr->displayFocusPtr = displayFocusPtr;
return displayFocusPtr;
}
+
diff --git a/tk/generic/tkFont.c b/tk/generic/tkFont.c
index 018199f6c2b..4ced32a9e59 100644
--- a/tk/generic/tkFont.c
+++ b/tk/generic/tkFont.c
@@ -6,7 +6,7 @@
* displaying text.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * 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.
@@ -14,6 +14,7 @@
* RCS: @(#) $Id$
*/
+#include "tkPort.h"
#include "tkInt.h"
#include "tkFont.h"
@@ -25,26 +26,19 @@
typedef struct TkFontInfo {
Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font.
- * Keys are CachedFontKey structs, values are
- * TkFont structs. */
+ * 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
- * Tk_Uids, values are NamedFont structs. */
+ * strings, values are NamedFont pointers. */
TkMainInfo *mainPtr; /* Application that owns this structure. */
- int updatePending;
+ int updatePending; /* Non-zero when a World Changed event has
+ * already been queued to handle a change to
+ * a named font. */
} TkFontInfo;
/*
- * The following structure is used as a key in the fontCache.
- */
-
-typedef struct CachedFontKey {
- Display *display; /* Display for which font was constructed. */
- Tk_Uid string; /* String that describes font. */
-} CachedFontKey;
-
-/*
* The following data structure is used to keep track of the font attributes
* for each named font that has been defined. The named font is only deleted
* when the last reference to it goes away.
@@ -77,6 +71,7 @@ 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
@@ -168,13 +163,6 @@ static TkStateMap xlfdSetwidthMap[] = {
{TK_SW_UNKNOWN, NULL}
};
-static TkStateMap xlfdCharsetMap[] = {
- {TK_CS_NORMAL, "iso8859"},
- {TK_CS_SYMBOL, "adobe"},
- {TK_CS_SYMBOL, "sun"},
- {TK_CS_OTHER, NULL}
-};
-
/*
* The following structure and defines specify the valid builtin options
* when configuring a set of font attributes.
@@ -196,7 +184,136 @@ static char *fontOpt[] = {
#define FONT_SLANT 3
#define FONT_UNDERLINE 4
#define FONT_OVERSTRIKE 5
-#define FONT_NUMFIELDS 6 /* Length of fontOpt array. */
+#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)
@@ -208,7 +325,13 @@ static char *fontOpt[] = {
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,
@@ -218,12 +341,27 @@ 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 UpdateDependantFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
+static void UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));
-
+/*
+ * The following structure defines the implementation of the "font" Tcl
+ * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
+ * each font object points to the TkFont structure for the font, or
+ * NULL.
+ */
+
+static Tcl_ObjType fontObjType = {
+ "font", /* name */
+ FreeFontObjProc, /* freeIntRepProc */
+ DupFontObjProc, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetFontFromAny /* setFromAnyProc */
+};
/*
@@ -236,8 +374,8 @@ static void UpdateDependantFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
* package on a per application basis.
*
* Results:
- * Returns a token that must be stored in the TkMainInfo for this
- * application.
+ * Stores a token in the mainPtr to hold information needed by this
+ * package on a per application basis.
*
* Side effects:
* Memory allocated.
@@ -251,11 +389,13 @@ TkFontPkgInit(mainPtr)
TkFontInfo *fiPtr;
fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
- Tcl_InitHashTable(&fiPtr->fontCache, sizeof(CachedFontKey) / sizeof(int));
- Tcl_InitHashTable(&fiPtr->namedTable, TCL_ONE_WORD_KEYS);
+ 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);
}
/*
@@ -281,12 +421,21 @@ TkFontPkgFree(mainPtr)
TkMainInfo *mainPtr; /* The application being deleted. */
{
TkFontInfo *fiPtr;
- Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *hPtr, *searchPtr;
Tcl_HashSearch search;
+ int fontsLeft;
fiPtr = mainPtr->fontInfoPtr;
- if (fiPtr->fontCache.numEntries != 0) {
+ fontsLeft = 0;
+ for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
+ searchPtr != NULL;
+ searchPtr = Tcl_NextHashEntry(&search)) {
+ fontsLeft++;
+ fprintf(stderr, "Font %s still in cache.\n",
+ Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
+ }
+ if (fontsLeft) {
panic("TkFontPkgFree: all fonts should have been freed already");
}
Tcl_DeleteHashTable(&fiPtr->fontCache);
@@ -368,7 +517,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
"font ?-displayof window? ?option?");
return TCL_ERROR;
}
- tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
if (tkfont == NULL) {
return TCL_ERROR;
}
@@ -394,14 +543,14 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
return TCL_ERROR;
}
- string = Tk_GetUid(Tcl_GetStringFromObj(objv[2], NULL));
+ 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_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string,
+ Tcl_AppendResult(interp, "named font \"", string,
"\" doesn't exist", NULL);
return TCL_ERROR;
}
@@ -412,7 +561,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
} else {
result = ConfigAttributesObj(interp, tkwin, objc - 3,
objv + 3, &nfPtr->fa);
- UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
return result;
}
return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
@@ -420,7 +569,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
case FONT_CREATE: {
int skip, i;
char *name;
- char buf[32];
+ char buf[16 + TCL_INTEGER_SPACE];
TkFontAttributes fa;
Tcl_HashEntry *namedHashPtr;
@@ -428,7 +577,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
if (objc < 3) {
name = NULL;
} else {
- name = Tcl_GetStringFromObj(objv[2], NULL);
+ name = Tcl_GetString(objv[2]);
if (name[0] == '-') {
name = NULL;
}
@@ -440,8 +589,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
for (i = 1; ; i++) {
sprintf(buf, "font%d", i);
- namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
- Tk_GetUid(buf));
+ namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
if (namedHashPtr == NULL) {
break;
}
@@ -454,10 +602,10 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
&fa) != TCL_OK) {
return TCL_ERROR;
}
- if (TkCreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
+ if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);
+ Tcl_AppendResult(interp, name, NULL);
break;
}
case FONT_DELETE: {
@@ -476,10 +624,10 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
for (i = 2; i < objc; i++) {
- string = Tk_GetUid(Tcl_GetStringFromObj(objv[i], NULL));
+ string = Tcl_GetString(objv[i]);
namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
if (namedHashPtr == NULL) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "named font \"", string,
+ Tcl_AppendResult(interp, "named font \"", string,
"\" doesn't exist", (char *) NULL);
return TCL_ERROR;
}
@@ -511,6 +659,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
char *string;
Tk_Font tkfont;
int length, skip;
+ Tcl_Obj *resultPtr;
skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
if (skip < 0) {
@@ -521,17 +670,17 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
"font ?-displayof window? text");
return TCL_ERROR;
}
- tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
if (tkfont == NULL) {
return TCL_ERROR;
}
string = Tcl_GetStringFromObj(objv[3 + skip], &length);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), Tk_TextWidth(tkfont, string, length));
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
Tk_FreeFont(tkfont);
break;
}
case FONT_METRICS: {
- char buf[64];
Tk_Font tkfont;
int skip, index, i;
CONST TkFontMetrics *fmPtr;
@@ -548,7 +697,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
"font ?-displayof window? ?option?");
return TCL_ERROR;
}
- tkfont = Tk_GetFontFromObj(interp, tkwin, objv[2]);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
if (tkfont == NULL) {
return TCL_ERROR;
}
@@ -556,11 +705,13 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
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_SetStringObj(Tcl_GetObjResult(interp), buf, -1);
+ Tcl_AppendResult(interp, buf, NULL);
} else {
if (Tcl_GetIndexFromObj(interp, objv[3], switches,
"metric", 0, &index) != TCL_OK) {
@@ -582,22 +733,23 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
}
case FONT_NAMES: {
char *string;
- Tcl_Obj *strPtr;
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, Tcl_GetObjResult(interp), strPtr);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
}
namedHashPtr = Tcl_NextHashEntry(&search);
}
@@ -610,7 +762,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
/*
*---------------------------------------------------------------------------
*
- * UpdateDependantFonts, TheWorldHasChanged, RecomputeWidgets --
+ * 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
@@ -627,7 +779,7 @@ Tk_FontObjCmd(clientData, interp, objc, objv)
*/
static void
-UpdateDependantFonts(fiPtr, tkwin, namedHashPtr)
+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. */
@@ -647,15 +799,16 @@ UpdateDependantFonts(fiPtr, tkwin, namedHashPtr)
return;
}
-
cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
while (cacheHashPtr != NULL) {
- fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
- if (fontPtr->namedHashPtr == namedHashPtr) {
- TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
- if (fiPtr->updatePending == 0) {
- fiPtr->updatePending = 1;
- Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
+ 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);
@@ -690,7 +843,7 @@ RecomputeWidgets(winPtr)
/*
*---------------------------------------------------------------------------
*
- * TkCreateNamedFont --
+ * CreateNamedFont --
*
* Create the specified named font with the given attributes in the
* named font table associated with the interp.
@@ -698,7 +851,7 @@ RecomputeWidgets(winPtr)
* Results:
* Returns TCL_OK if the font was successfully created, or TCL_ERROR
* if the named font already existed. If TCL_ERROR is returned, an
- * error message is left in interp->result.
+ * error message is left in the interp's result.
*
* Side effects:
* Assume there used to exist a named font by the specified name, and
@@ -711,8 +864,8 @@ RecomputeWidgets(winPtr)
*---------------------------------------------------------------------------
*/
-int
-TkCreateNamedFont(interp, tkwin, name, faPtr)
+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. */
@@ -725,14 +878,13 @@ TkCreateNamedFont(interp, tkwin, name, faPtr)
fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
- name = Tk_GetUid(name);
namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
if (new == 0) {
nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
if (nfPtr->deletePending == 0) {
- interp->result[0] = '\0';
- Tcl_AppendResult(interp, "font \"", name,
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "named font \"", name,
"\" already exists", (char *) NULL);
return TCL_ERROR;
}
@@ -745,7 +897,7 @@ TkCreateNamedFont(interp, tkwin, name, faPtr)
nfPtr->fa = *faPtr;
nfPtr->deletePending = 0;
- UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
return TCL_OK;
}
@@ -769,13 +921,13 @@ TkCreateNamedFont(interp, tkwin, name, faPtr)
* Results:
* The return value is token for the font, or NULL if an error
* prevented the font from being created. If NULL is returned, an
- * error message will be left in interp->result.
+ * error message will be left in the interp's result.
*
* Side effects:
- * Calls Tk_GetFontFromObj(), which modifies interp's result object,
- * then copies the string from the result object into interp->result.
- * This procedure will go away when Tk_ConfigureWidget() is
- * made into an object command.
+ * 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.
*
*---------------------------------------------------------------------------
*/
@@ -787,26 +939,20 @@ Tk_GetFont(interp, tkwin, string)
CONST char *string; /* String describing font, as: named font,
* native format, or parseable string. */
{
+ Tk_Font tkfont;
Tcl_Obj *strPtr;
- Tk_Font tkfont;
-
- strPtr = Tcl_NewStringObj((char *) string, -1);
-
- tkfont = Tk_GetFontFromObj(interp, tkwin, strPtr);
- if (tkfont == NULL) {
- Tcl_SetResult(interp,
- Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL),
- TCL_VOLATILE);
- }
- Tcl_DecrRefCount(strPtr); /* done with object */
+ strPtr = Tcl_NewStringObj((char *) string, -1);
+ Tcl_IncrRefCount(strPtr);
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
+ Tcl_DecrRefCount(strPtr);
return tkfont;
}
/*
*---------------------------------------------------------------------------
*
- * Tk_GetFontFromObj --
+ * Tk_AllocFontFromObj --
*
* Given a string description of a font, map the description to a
* corresponding Tk_Font that represents the font.
@@ -819,46 +965,77 @@ Tk_GetFont(interp, tkwin, string)
* Side effects:
* The font is added to an internal database with a reference
* count. For each call to this procedure, there should eventually
- * be a call to Tk_FreeFont() so that the database is cleaned up when
- * fonts aren't in use anymore.
+ * 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_GetFontFromObj(interp, tkwin, objPtr)
+Tk_AllocFontFromObj(interp, tkwin, objPtr)
Tcl_Interp *interp; /* Interp for database and error return. */
- Tk_Window tkwin; /* For display on which font will be used. */
+ 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;
- CachedFontKey key;
Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
- TkFont *fontPtr;
+ TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
int new, descent;
NamedFont *nfPtr;
- char *string;
-
+
fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
- string = Tcl_GetStringFromObj(objPtr, NULL);
+ if (objPtr->typePtr != &fontObjType) {
+ SetFontFromAny(interp, objPtr);
+ }
- key.display = Tk_Display(tkwin);
- key.string = Tk_GetUid(string);
- cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache, (char *) &key, &new);
+ oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
- if (new == 0) {
- /*
- * We have already constructed a font with this description for
- * this display. Bump the reference count of the cached font.
- */
+ 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.
+ */
- fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
- fontPtr->refCount++;
- return (Tk_Font) fontPtr;
+ FreeFontObjProc(objPtr);
+ oldFontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
+ oldFontPtr->resourceRefCount++;
+ return (Tk_Font) oldFontPtr;
+ }
}
- namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, key.string);
+ /*
+ * 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.
@@ -873,15 +1050,19 @@ Tk_GetFontFromObj(interp, tkwin, objPtr)
* Native font?
*/
- fontPtr = TkpGetNativeFont(tkwin, string);
+ fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
if (fontPtr == NULL) {
TkFontAttributes fa;
+ Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
- TkInitFontAttributes(&fa);
- if (ParseFontNameObj(interp, tkwin, objPtr, &fa) != TCL_OK) {
- Tcl_DeleteHashEntry(cacheHashPtr);
+ 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.
@@ -890,13 +1071,16 @@ Tk_GetFontFromObj(interp, tkwin, objPtr)
fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
}
}
- Tcl_SetHashValue(cacheHashPtr, fontPtr);
- fontPtr->refCount = 1;
- fontPtr->cacheHashPtr = cacheHashPtr;
- fontPtr->namedHashPtr = namedHashPtr;
+ 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, 0, 0, &fontPtr->tabWidth);
+ Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
if (fontPtr->tabWidth == 0) {
fontPtr->tabWidth = fontPtr->fm.maxWidth;
}
@@ -918,7 +1102,7 @@ Tk_GetFontFromObj(interp, tkwin, objPtr)
descent = fontPtr->fm.descent;
fontPtr->underlinePos = descent / 2;
- fontPtr->underlineHeight = fontPtr->fa.pointsize / 10;
+ fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10;
if (fontPtr->underlineHeight == 0) {
fontPtr->underlineHeight = 1;
}
@@ -936,10 +1120,125 @@ Tk_GetFontFromObj(interp, tkwin, objPtr)
}
}
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
return (Tk_Font) fontPtr;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetFontFromObj --
+ *
+ * Find the font that corresponds to a given object. The font must
+ * have already been created by Tk_GetFont or Tk_AllocFontFromObj.
+ *
+ * Results:
+ * The return value is a token for the font that matches objPtr
+ * and is suitable for use in tkwin.
+ *
+ * Side effects:
+ * If the object is not already a font ref, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Font
+Tk_GetFontFromObj(tkwin, objPtr)
+ Tk_Window tkwin; /* The window that the font will be used in. */
+ Tcl_Obj *objPtr; /* The object from which to get the font. */
+{
+ TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+ TkFont *fontPtr;
+ Tcl_HashEntry *hashPtr;
+
+ if (objPtr->typePtr != &fontObjType) {
+ SetFontFromAny((Tcl_Interp *) NULL, objPtr);
+ }
+
+ fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (fontPtr != NULL) {
+ if (fontPtr->resourceRefCount == 0) {
+ /*
+ * This is a stale reference: it refers to a TkFont that's
+ * no longer in use. Clear the reference.
+ */
+
+ FreeFontObjProc(objPtr);
+ fontPtr = NULL;
+ } else if (Tk_Screen(tkwin) == fontPtr->screen) {
+ return (Tk_Font) fontPtr;
+ }
+ }
+
+ /*
+ * Next, search the list of fonts that have the name we want, to see
+ * if one of them is for the right screen.
+ */
+
+ if (fontPtr != NULL) {
+ hashPtr = fontPtr->cacheHashPtr;
+ FreeFontObjProc(objPtr);
+ } else {
+ hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
+ }
+ if (hashPtr != NULL) {
+ for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
+ fontPtr = fontPtr->nextPtr) {
+ if (Tk_Screen(tkwin) == fontPtr->screen) {
+ fontPtr->objRefCount++;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
+ return (Tk_Font) fontPtr;
+ }
+ }
+ }
+
+ panic("Tk_GetFontFromObj called with non-existent font!");
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFontFromAny --
+ *
+ * Convert the internal representation of a Tcl object to the
+ * font internal form.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * The object is left with its typePtr pointing to fontObjType.
+ * The TkFont pointer is NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetFontFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetString(objPtr);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &fontObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+
+ return TCL_OK;
+}
+
+/*
*---------------------------------------------------------------------------
*
* Tk_NameOfFont --
@@ -963,14 +1262,9 @@ Tk_NameOfFont(tkfont)
Tk_Font tkfont; /* Font whose name is desired. */
{
TkFont *fontPtr;
- Tcl_HashEntry *hPtr;
- CachedFontKey *keyPtr;
fontPtr = (TkFont *) tkfont;
- hPtr = fontPtr->cacheHashPtr;
-
- keyPtr = (CachedFontKey *) Tcl_GetHashKey(hPtr->tablePtr, hPtr);
- return (char *) keyPtr->string;
+ return fontPtr->cacheHashPtr->key.string;
}
/*
@@ -994,30 +1288,144 @@ void
Tk_FreeFont(tkfont)
Tk_Font tkfont; /* Font to be released. */
{
- TkFont *fontPtr;
+ TkFont *fontPtr, *prevPtr;
NamedFont *nfPtr;
if (tkfont == NULL) {
return;
}
fontPtr = (TkFont *) tkfont;
- fontPtr->refCount--;
- if (fontPtr->refCount == 0) {
- if (fontPtr->namedHashPtr != NULL) {
- /*
- * The font is being deleted. Determine if the associated named
- * font definition should and/or can be deleted too.
- */
+ 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);
- }
+ 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;
}
- Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
- TkpDeleteFont(fontPtr);
+ 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++;
}
}
@@ -1112,7 +1520,6 @@ Tk_GetFontMetrics(tkfont, fmPtr)
*---------------------------------------------------------------------------
*/
-
int
Tk_PostscriptFontName(tkfont, dsPtr)
Tk_Font tkfont; /* Font in which text will be printed. */
@@ -1154,6 +1561,8 @@ Tk_PostscriptFontName(tkfont, dsPtr)
} 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
@@ -1165,16 +1574,19 @@ Tk_PostscriptFontName(tkfont, dsPtr)
src = dest = Tcl_DStringValue(dsPtr) + len;
upper = 1;
- for (; *src != '\0'; src++, dest++) {
- while (isspace(UCHAR(*src))) {
+ for (; *src != '\0'; ) {
+ while (isspace(UCHAR(*src))) { /* INTL: ISO space */
src++;
upper = 1;
}
- *dest = *src;
- if ((upper != 0) && (islower(UCHAR(*src)))) {
- *dest = toupper(UCHAR(*src));
+ src += Tcl_UtfToUniChar(src, &ch);
+ if (upper) {
+ ch = Tcl_UniCharToUpper(ch);
+ upper = 0;
+ } else {
+ ch = Tcl_UniCharToLower(ch);
}
- upper = 0;
+ dest += Tcl_UniCharToUtf(ch, dest);
}
*dest = '\0';
Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
@@ -1251,7 +1663,7 @@ Tk_PostscriptFontName(tkfont, dsPtr)
}
}
- return fontPtr->fa.pointsize;
+ return fontPtr->fa.size;
}
/*
@@ -1273,18 +1685,18 @@ Tk_PostscriptFontName(tkfont, dsPtr)
*/
int
-Tk_TextWidth(tkfont, string, numChars)
+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 numChars; /* Number of characters to consider from
+ int numBytes; /* Number of bytes to consider from
* string, or < 0 for strlen(). */
{
int width;
- if (numChars < 0) {
- numChars = strlen(string);
+ if (numBytes < 0) {
+ numBytes = strlen(string);
}
- Tk_MeasureChars(tkfont, string, numChars, 0, 0, &width);
+ Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
return width;
}
@@ -1311,8 +1723,8 @@ Tk_TextWidth(tkfont, string, numChars)
*/
void
-Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstChar,
- lastChar)
+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
@@ -1324,16 +1736,17 @@ Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstChar,
* underlined or overstruck. */
int x, y; /* Coordinates at which first character of
* string is drawn. */
- int firstChar; /* Index of first character. */
- int lastChar; /* Index of one after the last character. */
+ 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, firstChar, 0, 0, &startX);
- Tk_MeasureChars(tkfont, string, lastChar, 0, 0, &endX);
+ 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),
@@ -1394,26 +1807,37 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
{
TkFont *fontPtr;
CONST char *start, *end, *special;
- int n, y, charsThisChunk, maxChunks;
+ int n, y, bytesThisChunk, maxChunks;
int baseline, height, curX, newX, maxWidth;
TextLayout *layoutPtr;
LayoutChunk *chunkPtr;
CONST TkFontMetrics *fmPtr;
-#define MAX_LINES 50
- int staticLineLengths[MAX_LINES];
+ Tcl_DString lineBuffer;
int *lineLengths;
- int maxLines, curLine, layoutHeight;
+ int curLine, layoutHeight;
- lineLengths = staticLineLengths;
- maxLines = MAX_LINES;
+ 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 = strlen(string);
+ numChars = Tcl_NumUtfChars(string, -1);
+ }
+ if (wrapLength == 0) {
+ wrapLength = -1;
}
maxChunks = 1;
@@ -1433,16 +1857,20 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
curX = 0;
- end = string + numChars;
+ end = Tcl_UtfAtIndex(string, numChars);
special = string;
flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
- curLine = 0;
for (start = string; start < end; ) {
if (start >= special) {
/*
* Find the next special character in the string.
+ *
+ * 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++) {
@@ -1466,15 +1894,15 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
chunkPtr = NULL;
if (start < special) {
- charsThisChunk = Tk_MeasureChars(tkfont, start, special - start,
+ bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
wrapLength - curX, flags, &newX);
newX += curX;
flags &= ~TK_AT_LEAST_ONE;
- if (charsThisChunk > 0) {
+ if (bytesThisChunk > 0) {
chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
- charsThisChunk, curX, newX, baseline);
+ bytesThisChunk, curX, newX, baseline);
- start += charsThisChunk;
+ start += bytesThisChunk;
curX = newX;
}
}
@@ -1482,6 +1910,9 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
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;
@@ -1502,7 +1933,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
continue;
}
} else {
- NewChunk(&layoutPtr, &maxChunks, start, 1, curX, 1000000000,
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, curX,
baseline)->numDisplayChars = -1;
start++;
goto wrapLine;
@@ -1515,7 +1946,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
* Consume all extra spaces at end of line.
*/
- while ((start < end) && isspace(UCHAR(*start))) {
+ while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
if (!(flags & TK_IGNORE_NEWLINES)) {
if ((*start == '\n') || (*start == '\r')) {
break;
@@ -1529,15 +1960,21 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
start++;
}
if (chunkPtr != NULL) {
+ CONST char *end;
+
/*
* Append all the extra spaces on this line to the end of the
- * last text chunk.
+ * last text chunk. This is a little tricky because we are
+ * switching back and forth between characters and bytes.
*/
- charsThisChunk = start - (chunkPtr->start + chunkPtr->numChars);
- if (charsThisChunk > 0) {
- chunkPtr->numChars += Tk_MeasureChars(tkfont,
- chunkPtr->start + chunkPtr->numChars, charsThisChunk,
- 0, 0, &chunkPtr->totalWidth);
+
+ 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;
}
}
@@ -1559,19 +1996,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
* can be centered or right justified, if necessary.
*/
- if (curLine >= maxLines) {
- int *newLengths;
-
- newLengths = (int *) ckalloc(2 * maxLines * sizeof(int));
- memcpy((void *) newLengths, lineLengths, maxLines * sizeof(int));
- if (lineLengths != staticLineLengths) {
- ckfree((char *) lineLengths);
- }
- lineLengths = newLengths;
- maxLines *= 2;
- }
- lineLengths[curLine] = curX;
- curLine++;
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
curX = 0;
baseline += height;
@@ -1586,36 +2011,13 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
- 1000000000, baseline);
+ curX, baseline);
chunkPtr->numDisplayChars = -1;
+ Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
baseline += height;
}
}
- /*
- * Using maximum line length, shift all the chunks so that the lines are
- * all justified correctly.
- */
-
- curLine = 0;
- chunkPtr = layoutPtr->chunks;
- y = chunkPtr->y;
- for (n = 0; n < layoutPtr->numChunks; n++) {
- int extra;
-
- if (chunkPtr->y != y) {
- curLine++;
- y = chunkPtr->y;
- }
- extra = maxWidth - lineLengths[curLine];
- if (justify == TK_JUSTIFY_CENTER) {
- chunkPtr->x += extra / 2;
- } else if (justify == TK_JUSTIFY_RIGHT) {
- chunkPtr->x += extra;
- }
- chunkPtr++;
- }
-
layoutPtr->width = maxWidth;
layoutHeight = baseline - fmPtr->ascent;
if (layoutPtr->numChunks == 0) {
@@ -1629,12 +2031,38 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
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) {
@@ -1643,9 +2071,7 @@ Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
if (heightPtr != NULL) {
*heightPtr = layoutHeight;
}
- if (lineLengths != staticLineLengths) {
- ckfree((char *) lineLengths);
- }
+ Tcl_DStringFree(&lineBuffer);
return (Tk_TextLayout) layoutPtr;
}
@@ -1718,6 +2144,8 @@ Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
{
TextLayout *layoutPtr;
int i, numDisplayChars, drawX;
+ CONST char *firstByte;
+ CONST char *lastByte;
LayoutChunk *chunkPtr;
layoutPtr = (TextLayout *) layout;
@@ -1735,15 +2163,18 @@ Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
if (firstChar <= 0) {
drawX = 0;
firstChar = 0;
+ firstByte = chunkPtr->start;
} else {
- Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start, firstChar,
- 0, 0, &drawX);
+ 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,
- chunkPtr->start + firstChar, numDisplayChars - firstChar,
+ firstByte, lastByte - firstByte,
x + chunkPtr->x + drawX, y + chunkPtr->y);
}
firstChar -= chunkPtr->numChars;
@@ -1791,18 +2222,21 @@ Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
int underline; /* Index of the single character to
* underline, or -1 for no underline. */
{
- TextLayout *layoutPtr;
+ TextLayout *layoutPtr = (TextLayout *) layout;
TkFont *fontPtr;
- int xx, yy, width, height;
+ int xx, yy, width, height, underlineByte;
- if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
- && (width != 0)) {
- layoutPtr = (TextLayout *) layout;
- fontPtr = (TkFont *) layoutPtr->tkfont;
+ if (underline > -1) {
+ underlineByte = Tcl_UtfAtIndex(layoutPtr->string, underline)
+ - layoutPtr->string;
+ if ((Tk_CharBbox(layout, underlineByte, &xx, &yy, &width, &height) != 0)
+ && (width != 0)) {
+ fontPtr = (TkFont *) layoutPtr->tkfont;
- XFillRectangle(display, drawable, gc, x + xx,
- y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
- (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
+ XFillRectangle(display, drawable, gc, x + xx,
+ y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
+ (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
+ }
}
}
@@ -1849,7 +2283,7 @@ Tk_PointToChar(layout, x, y)
TextLayout *layoutPtr;
LayoutChunk *chunkPtr, *lastPtr;
TkFont *fontPtr;
- int i, n, dummy, baseline, pos;
+ int i, n, dummy, baseline, pos, numChars;
if (y < 0) {
/*
@@ -1867,6 +2301,7 @@ Tk_PointToChar(layout, x, y)
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) {
@@ -1876,7 +2311,7 @@ Tk_PointToChar(layout, x, y)
* the index of the first character on this line.
*/
- return chunkPtr->start - layoutPtr->string;
+ return numChars;
}
if (x >= layoutPtr->width) {
/*
@@ -1907,13 +2342,14 @@ Tk_PointToChar(layout, x, y)
* tab or newline char.
*/
- return chunkPtr->start - layoutPtr->string;
+ return numChars;
}
n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
- chunkPtr->numChars, x + 1 - chunkPtr->x,
- TK_PARTIAL_OK, &dummy);
- return (chunkPtr->start + n - 1) - layoutPtr->string;
+ chunkPtr->numBytes, x - chunkPtr->x,
+ 0, &dummy);
+ return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
}
+ numChars += chunkPtr->numChars;
lastPtr = chunkPtr;
chunkPtr++;
i++;
@@ -1925,12 +2361,13 @@ Tk_PointToChar(layout, x, y)
* chunk on this line.
*/
- pos = (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
+ pos = numChars;
if (i < layoutPtr->numChunks) {
pos--;
}
return pos;
}
+ numChars += chunkPtr->numChars;
lastPtr = chunkPtr;
chunkPtr++;
}
@@ -1997,6 +2434,7 @@ Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
int i, x, w;
Tk_Font tkfont;
TkFont *fontPtr;
+ CONST char *end;
if (index < 0) {
if (xPtr)
@@ -2023,12 +2461,15 @@ Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
goto check;
}
} else if (index < chunkPtr->numChars) {
+ end = Tcl_UtfAtIndex(chunkPtr->start, index);
if (xPtr != NULL) {
- Tk_MeasureChars(tkfont, chunkPtr->start, index, 0, 0, &x);
+ Tk_MeasureChars(tkfont, chunkPtr->start,
+ end - chunkPtr->start, -1, 0, &x);
x += chunkPtr->x;
}
if (widthPtr != NULL) {
- Tk_MeasureChars(tkfont, chunkPtr->start + index, 1, 0, 0, &w);
+ Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
+ -1, 0, &w);
}
goto check;
}
@@ -2284,7 +2725,7 @@ Tk_IntersectTextLayout(layout, x, y, width, height)
* location of the baseline for the string.
*
* Results:
- * Interp->result is modified to hold the Postscript code that
+ * The interp's result is modified to hold the Postscript code that
* will render the text layout.
*
* Side effects:
@@ -2302,6 +2743,8 @@ Tk_TextLayoutToPostscript(interp, layout)
char buf[MAXUSE+10];
LayoutChunk *chunkPtr;
int i, j, used, c, baseline;
+ Tcl_UniChar ch;
+ CONST char *p;
TextLayout *layoutPtr;
layoutPtr = (TextLayout *) layout;
@@ -2322,8 +2765,16 @@ Tk_TextLayoutToPostscript(interp, layout)
buf[used++] = 't';
}
} else {
+ p = chunkPtr->start;
for (j = 0; j < chunkPtr->numDisplayChars; j++) {
- c = UCHAR(chunkPtr->start[j]);
+ /*
+ * INTL: For now we just treat the characters as binary
+ * data and display the lower byte. Eventually this should
+ * be revised to handle international postscript fonts.
+ */
+
+ p += Tcl_UtfToUniChar(p, &ch);
+ c = UCHAR(ch & 0xff);
if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
|| (c >= UCHAR(0x7f))) {
/*
@@ -2367,36 +2818,6 @@ Tk_TextLayoutToPostscript(interp, layout)
/*
*---------------------------------------------------------------------------
*
- * TkInitFontAttributes --
- *
- * Initialize the font attributes structure to contain sensible
- * values. This must be called before using any other font
- * attributes functions.
- *
- * Results:
- * None.
- *
- * Side effects.
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TkInitFontAttributes(faPtr)
- TkFontAttributes *faPtr; /* The attributes structure to initialize. */
-{
- faPtr->family = NULL;
- faPtr->pointsize = 0;
- faPtr->weight = TK_FW_NORMAL;
- faPtr->slant = TK_FS_ROMAN;
- faPtr->underline = 0;
- faPtr->overstrike = 0;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* ConfigAttributesObj --
*
* Process command line options to fill in fields of a properly
@@ -2427,68 +2848,74 @@ ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
* be properly initialized. */
{
int i, n, index;
- Tcl_Obj *value;
- char *option, *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+ char *value;
- if (objc & 1) {
- string = Tcl_GetStringFromObj(objv[objc - 1], NULL);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "missing value for \"",
- string, "\" option", (char *) NULL);
- return TCL_ERROR;
- }
-
for (i = 0; i < objc; i += 2) {
- option = Tcl_GetStringFromObj(objv[i], NULL);
- value = objv[i + 1];
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
- if (Tcl_GetIndexFromObj(interp, objv[i], fontOpt, "option", 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:
- string = Tcl_GetStringFromObj(value, NULL);
- faPtr->family = Tk_GetUid(string);
+ case FONT_FAMILY: {
+ value = Tcl_GetString(valuePtr);
+ faPtr->family = Tk_GetUid(value);
break;
-
- case FONT_SIZE:
- if (Tcl_GetIntFromObj(interp, value, &n) != TCL_OK) {
+ }
+ case FONT_SIZE: {
+ if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
return TCL_ERROR;
}
- faPtr->pointsize = n;
+ faPtr->size = n;
break;
-
- case FONT_WEIGHT:
- string = Tcl_GetStringFromObj(value, NULL);
- n = TkFindStateNum(interp, option, weightMap, string);
+ }
+ case FONT_WEIGHT: {
+ n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
if (n == TK_FW_UNKNOWN) {
return TCL_ERROR;
}
faPtr->weight = n;
break;
-
- case FONT_SLANT:
- string = Tcl_GetStringFromObj(value, NULL);
- n = TkFindStateNum(interp, option, slantMap, string);
+ }
+ 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, value, &n) != TCL_OK) {
+ }
+ 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, value, &n) != TCL_OK) {
+ }
+ case FONT_OVERSTRIKE: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
return TCL_ERROR;
}
faPtr->overstrike = n;
break;
+ }
}
}
return TCL_OK;
@@ -2523,18 +2950,19 @@ GetAttributeInfoObj(interp, faPtr, objPtr)
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. */
+ * returned. Otherwise information is
+ * returned for all options. */
{
- int i, index, start, end, num;
+ int i, index, start, end;
char *str;
- Tcl_Obj *newPtr;
+ Tcl_Obj *optionPtr, *valuePtr, *resultPtr;
+
+ resultPtr = Tcl_GetObjResult(interp);
start = 0;
end = FONT_NUMFIELDS;
if (objPtr != NULL) {
- if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", 1,
+ if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
&index) != TCL_OK) {
return TCL_ERROR;
}
@@ -2542,55 +2970,43 @@ GetAttributeInfoObj(interp, faPtr, objPtr)
end = index + 1;
}
+ valuePtr = NULL;
for (i = start; i < end; i++) {
- str = NULL;
- num = 0; /* Needed only to prevent compiler
- * warning. */
switch (i) {
case FONT_FAMILY:
str = faPtr->family;
- if (str == NULL) {
- str = "";
- }
+ valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
break;
case FONT_SIZE:
- num = faPtr->pointsize;
+ 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:
- num = faPtr->underline;
+ valuePtr = Tcl_NewBooleanObj(faPtr->underline);
break;
case FONT_OVERSTRIKE:
- num = faPtr->overstrike;
+ valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
break;
}
- if (objPtr == NULL) {
- Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
- Tcl_NewStringObj(fontOpt[i], -1));
- if (str != NULL) {
- newPtr = Tcl_NewStringObj(str, -1);
- } else {
- newPtr = Tcl_NewIntObj(num);
- }
- Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
- newPtr);
- } else {
- if (str != NULL) {
- Tcl_SetStringObj(Tcl_GetObjResult(interp), str, -1);
- } else {
- Tcl_SetIntObj(Tcl_GetObjResult(interp), num);
- }
+ 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;
}
@@ -2605,7 +3021,7 @@ GetAttributeInfoObj(interp, faPtr, objPtr)
*
* The string rep of the object can be one of the following forms:
* XLFD (see X documentation)
- * "Family [size [style] [style ...]]"
+ * "family [size] [style1 [style2 ...]"
* "-option value [-option value ...]"
*
* Results:
@@ -2622,20 +3038,23 @@ GetAttributeInfoObj(interp, faPtr, objPtr)
static int
ParseFontNameObj(interp, tkwin, objPtr, faPtr)
- Tcl_Interp *interp; /* Interp for error return. */
+ 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; /* Font attributes structure whose fields
- * are to be modified. Structure must already
- * be properly initialized. */
+ 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;
- TkXLFDAttributes xa;
char *string;
- string = Tcl_GetStringFromObj(objPtr, NULL);
+ TkInitFontAttributes(faPtr);
+
+ string = Tcl_GetString(objPtr);
if (*string == '-') {
/*
* This may be an XLFD or an "-option value" string.
@@ -2648,7 +3067,8 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
goto xlfd;
}
dash = strchr(string + 1, '-');
- if ((dash != NULL) && (!isspace(UCHAR(dash[-1])))) {
+ if ((dash != NULL)
+ && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
goto xlfd;
}
@@ -2661,15 +3081,16 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
if (*string == '*') {
/*
- * This appears to be an XLFD.
+ * 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:
- xa.fa = *faPtr;
- result = TkParseXLFD(string, &xa);
+ result = TkFontParseXLFD(string, faPtr, NULL);
if (result == TCL_OK) {
- *faPtr = xa.fa;
- return result;
+ return TCL_OK;
}
}
@@ -2678,21 +3099,19 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
* "font size style" list.
*/
- if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
- return TCL_ERROR;
- }
- if (objc < 1) {
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "font \"", string,
- "\" doesn't exist", (char *) NULL);
+ 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_GetStringFromObj(objv[0], NULL));
+ faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
if (objc > 1) {
if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
return TCL_ERROR;
}
- faPtr->pointsize = n;
+ faPtr->size = n;
}
i = 2;
@@ -2703,23 +3122,22 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
i = 0;
}
for ( ; i < objc; i++) {
- string = Tcl_GetStringFromObj(objv[i], NULL);
- n = TkFindStateNum(NULL, NULL, weightMap, string);
+ n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
if (n != TK_FW_UNKNOWN) {
faPtr->weight = n;
continue;
}
- n = TkFindStateNum(NULL, NULL, slantMap, string);
+ n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
if (n != TK_FS_UNKNOWN) {
faPtr->slant = n;
continue;
}
- n = TkFindStateNum(NULL, NULL, underlineMap, string);
+ n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
if (n != 0) {
faPtr->underline = n;
continue;
}
- n = TkFindStateNum(NULL, NULL, overstrikeMap, string);
+ n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
if (n != 0) {
faPtr->overstrike = n;
continue;
@@ -2729,9 +3147,8 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
* Unknown style.
*/
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "unknown font style \"", string, "\"",
- (char *) NULL);
+ Tcl_AppendResult(interp, "unknown font style \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2740,7 +3157,69 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
/*
*---------------------------------------------------------------------------
*
- * TkParseXLFD --
+ * 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.
*
@@ -2756,18 +3235,31 @@ ParseFontNameObj(interp, tkwin, objPtr, faPtr)
*/
int
-TkParseXLFD(string, xaPtr)
+TkFontParseXLFD(string, faPtr, xaPtr)
CONST char *string; /* Parseable font description string. */
- TkXLFDAttributes *xaPtr; /* XLFD attributes structure whose fields
- * are to be modified. Structure must already
- * be properly initialized. */
+ 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;
@@ -2781,27 +3273,32 @@ TkParseXLFD(string, xaPtr)
field[0] = src;
for (i = 0; *src != '\0'; src++) {
- if (isupper(UCHAR(*src))) {
- *src = tolower(UCHAR(*src));
+ if (!(*src & 0x80)
+ && Tcl_UniCharIsUpper(UCHAR(*src))) {
+ *src = (char) Tcl_UniCharToLower(UCHAR(*src));
}
if (*src == '-') {
i++;
- if (i > XLFD_NUMFIELDS) {
- break;
+ 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,
+ * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
* but it is (strictly) malformed, because the first * is eliding both
* the Setwidth and the Addstyle fields. If the Addstyle field is a
* number, then assume the above incorrect form was used and shift all
- * the rest of the fields up by one, so the number gets interpreted
+ * 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, but gives a syntax error under Windows".
+ * 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]))) {
@@ -2828,19 +3325,19 @@ TkParseXLFD(string, xaPtr)
}
if (FieldSpecified(field[XLFD_FAMILY])) {
- xaPtr->fa.family = Tk_GetUid(field[XLFD_FAMILY]);
+ faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
}
if (FieldSpecified(field[XLFD_WEIGHT])) {
- xaPtr->fa.weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
+ 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) {
- xaPtr->fa.slant = TK_FS_ROMAN;
+ faPtr->slant = TK_FS_ROMAN;
} else {
- xaPtr->fa.slant = TK_FS_ITALIC;
+ faPtr->slant = TK_FS_ITALIC;
}
}
if (FieldSpecified(field[XLFD_SETWIDTH])) {
@@ -2851,9 +3348,12 @@ TkParseXLFD(string, xaPtr)
/* XLFD_ADD_STYLE ignored. */
/*
- * Pointsize in tenths of a point, but treat it as tenths of a pixel.
+ * 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] == '[') {
/*
@@ -2866,10 +3366,10 @@ TkParseXLFD(string, xaPtr)
* the purpose of, so I ignore them.
*/
- xaPtr->fa.pointsize = atoi(field[XLFD_POINT_SIZE] + 1);
+ faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
} else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
- &xaPtr->fa.pointsize) == TCL_OK) {
- xaPtr->fa.pointsize /= 10;
+ &faPtr->size) == TCL_OK) {
+ faPtr->size /= 10;
} else {
return TCL_ERROR;
}
@@ -2891,14 +3391,14 @@ TkParseXLFD(string, xaPtr)
* the purpose of, so I ignore them.
*/
- xaPtr->fa.pointsize = atoi(field[XLFD_PIXEL_SIZE] + 1);
+ faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
} else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
- &xaPtr->fa.pointsize) != TCL_OK) {
+ &faPtr->size) != TCL_OK) {
return TCL_ERROR;
}
}
- xaPtr->fa.pointsize = -xaPtr->fa.pointsize;
+ faPtr->size = -faPtr->size;
/* XLFD_RESOLUTION_X ignored. */
@@ -2908,14 +3408,11 @@ TkParseXLFD(string, xaPtr)
/* XLFD_AVERAGE_WIDTH ignored. */
- if (FieldSpecified(field[XLFD_REGISTRY])) {
- xaPtr->charset = TkFindStateNum(NULL, NULL, xlfdCharsetMap,
- field[XLFD_REGISTRY]);
- }
- if (FieldSpecified(field[XLFD_ENCODING])) {
- xaPtr->encoding = atoi(field[XLFD_ENCODING]);
+ 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;
}
@@ -2957,61 +3454,225 @@ FieldSpecified(field)
/*
*---------------------------------------------------------------------------
*
- * NewChunk --
+ * TkFontGetPixels --
*
- * Helper function for Tk_ComputeTextLayout(). Encapsulates a
- * measured set of characters in a chunk that can be quickly
- * drawn.
+ * Given a font size specification (as described in the TkFontAttributes
+ * structure) return the number of pixels it represents.
*
* Results:
- * A pointer to the new chunk in the text layout.
+ * As above.
*
* Side effects:
- * The text layout is reallocated to hold more chunks as necessary.
+ * None.
*
- * 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.
+ *---------------------------------------------------------------------------
+ */
+
+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.
*
*---------------------------------------------------------------------------
*/
-static LayoutChunk *
-NewChunk(layoutPtrPtr, maxPtr, start, numChars, curX, newX, y)
- TextLayout **layoutPtrPtr;
- int *maxPtr;
- CONST char *start;
- int numChars;
- int curX;
- int newX;
- int y;
+
+int
+TkFontGetPoints(tkwin, size)
+ Tk_Window tkwin; /* For pixel->point conversion factor. */
+ int size; /* Font size. */
{
- TextLayout *layoutPtr;
- LayoutChunk *chunkPtr;
- int maxChunks;
- size_t s;
-
- layoutPtr = *layoutPtrPtr;
- maxChunks = *maxPtr;
- if (layoutPtr->numChunks == maxChunks) {
- maxChunks *= 2;
- s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
- layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);
+ double d;
- *layoutPtrPtr = layoutPtr;
- *maxPtr = maxChunks;
+ if (size >= 0) {
+ return size;
}
- chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
- chunkPtr->start = start;
- chunkPtr->numChars = numChars;
- chunkPtr->numDisplayChars = numChars;
- chunkPtr->x = curX;
- chunkPtr->y = y;
- chunkPtr->totalWidth = newX - curX;
- chunkPtr->displayWidth = newX - curX;
- layoutPtr->numChunks++;
- return chunkPtr;
+ 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;
}
/* CYGNUS LOCAL: This routine is called on Windows to update a named
@@ -3033,8 +3694,9 @@ TkUpdateFonts(tkwin, changed)
while (namedHashPtr != NULL) {
nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
if ((*changed)(&nfPtr->fa)) {
- UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
+ UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
}
namedHashPtr = Tcl_NextHashEntry(&search);
}
}
+
diff --git a/tk/generic/tkFont.h b/tk/generic/tkFont.h
index 7bd9928fbea..5c891e3e8e5 100644
--- a/tk/generic/tkFont.h
+++ b/tk/generic/tkFont.h
@@ -5,7 +5,7 @@
* specific parts of the font package. This information is not
* visible outside of the font package.
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * 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.
@@ -28,8 +28,9 @@
*/
typedef struct TkFontAttributes {
- Tk_Uid family; /* Font family. The most important field. */
- int pointsize; /* Pointsize of font, 0 for default size, or
+ 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. */
@@ -91,13 +92,25 @@ typedef struct TkFont {
* Fields used and maintained exclusively by generic code.
*/
- int refCount; /* Number of users of the TkFont. */
+ 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
@@ -106,7 +119,7 @@ typedef struct TkFont {
* underlines on a non-underlined font). */
/*
- * Fields in the generic font structure that are filled in by
+ * Fields used in the generic code that are filled in by
* platform-specific code.
*/
@@ -121,6 +134,11 @@ typedef struct TkFont {
* 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;
/*
@@ -130,16 +148,12 @@ typedef struct TkFont {
*/
typedef struct TkXLFDAttributes {
- TkFontAttributes fa; /* Standard set of font attributes. */
Tk_Uid foundry; /* The foundry of the font. */
int slant; /* The tristate value for the slant, which
* is significant under X. */
int setwidth; /* The proportionate width, see below for
* definition. */
- int charset; /* The character set encoding (the glyph
- * family), see below for definition. */
- int encoding; /* Variations within a charset for the
- * glyphs above character 127. */
+ Tk_Uid charset; /* The actual charset string. */
} TkXLFDAttributes;
/*
@@ -155,15 +169,6 @@ typedef struct TkXLFDAttributes {
* stored in the setwidth field. */
/*
- * Possible values for the "charset" field in a TkXLFDAttributes structure.
- * The charset is the set of glyphs that are used in the font.
- */
-
-#define TK_CS_NORMAL 0
-#define TK_CS_SYMBOL 1
-#define TK_CS_OTHER 2
-
-/*
* The following defines specify the meaning of the fields in a fully
* qualified XLFD.
*/
@@ -180,28 +185,33 @@ typedef struct TkXLFDAttributes {
#define XLFD_RESOLUTION_Y 9
#define XLFD_SPACING 10
#define XLFD_AVERAGE_WIDTH 11
-#define XLFD_REGISTRY 12
-#define XLFD_ENCODING 13
-#define XLFD_NUMFIELDS 14 /* Number of fields in XLFD. */
+#define XLFD_CHARSET 12
+#define XLFD_NUMFIELDS 13 /* Number of fields in XLFD. */
/*
- * Exported from generic code to platform-specific code.
+ * Low-level API exported by generic code to platform-specific code.
*/
-EXTERN int TkCreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, CONST char *name,
- TkFontAttributes *faPtr));
-EXTERN void TkInitFontAttributes _ANSI_ARGS_((
- TkFontAttributes *faPtr));
-EXTERN int TkParseXLFD _ANSI_ARGS_((CONST char *string,
- TkXLFDAttributes *xaPtr));
+#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));
/*
- * Common APIs exported to tkFont.c from all platform-specific
- * implementations.
+ * 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));
@@ -218,3 +228,5 @@ EXTERN void TkUpdateFonts _ANSI_ARGS_((Tk_Window tkwin,
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKFONT */
+
+
diff --git a/tk/generic/tkFrame.c b/tk/generic/tkFrame.c
index ded4e4ca4bd..949fb18c226 100644
--- a/tk/generic/tkFrame.c
+++ b/tk/generic/tkFrame.c
@@ -7,7 +7,7 @@
* attributes.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -167,22 +167,25 @@ static Tk_ConfigSpec configSpecs[] = {
*/
static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp,
- Frame *framePtr, int argc, char **argv,
+ Frame *framePtr, int objc, Tcl_Obj *CONST objv[],
int flags));
+static int CreateFrame _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST argv[],
+ int toplevel, char *appName));
static void DestroyFrame _ANSI_ARGS_((char *memPtr));
static void DisplayFrame _ANSI_ARGS_((ClientData clientData));
static void FrameCmdDeletedProc _ANSI_ARGS_((
ClientData clientData));
static void FrameEventProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
-static int FrameWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int FrameWidgetObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static void MapFrame _ANSI_ARGS_((ClientData clientData));
/*
*--------------------------------------------------------------
*
- * Tk_FrameCmd, Tk_ToplevelCmd --
+ * Tk_FrameObjCmd, Tk_ToplevelObjCmd --
*
* These procedures are invoked to process the "frame" and
* "toplevel" Tcl commands. See the user documentation for
@@ -199,31 +202,31 @@ static void MapFrame _ANSI_ARGS_((ClientData clientData));
*/
int
-Tk_FrameCmd(clientData, interp, argc, argv)
+Tk_FrameObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- return TkCreateFrame(clientData, interp, argc, argv, 0, (char *) NULL);
+ return CreateFrame(clientData, interp, objc, objv, 0, (char *) NULL);
}
int
-Tk_ToplevelCmd(clientData, interp, argc, argv)
+Tk_ToplevelObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- return TkCreateFrame(clientData, interp, argc, argv, 1, (char *) NULL);
+ return CreateFrame(clientData, interp, objc, objv, 1, (char *) NULL);
}
/*
*--------------------------------------------------------------
*
- * TkFrameCreate --
+ * TkCreateFrame --
*
* This procedure is invoked to process the "frame" and "toplevel"
* Tcl commands; it is also invoked directly by Tk_Init to create
@@ -253,18 +256,47 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
* NULL: 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, appName);
+ for (i=0; i<argc; i++) {
+ Tcl_DecrRefCount(objv[i]);
+ }
+ ckfree((char *) objv);
+ return result;
+}
+
+static int
+CreateFrame(clientData, interp, objc, objv, toplevel, appName)
+ ClientData clientData; /* Main window associated with interpreter.
+ * If we're called by Tk_Init to create a
+ * new application, then this is NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int toplevel; /* Non-zero means create a toplevel window,
+ * zero means create a frame. */
+ char *appName; /* Should only be non-NULL if clientData is
+ * NULL: gives the base name to use for the
+ * new application. */
+{
Tk_Window tkwin = (Tk_Window) clientData;
Frame *framePtr;
Tk_Window new;
char *className, *screenName, *visualName, *colormapName, *arg, *useOption;
- int i, c, length, depth;
+ int i, c, depth;
+ size_t length;
unsigned int mask;
Colormap colormap;
Visual *visual;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
@@ -277,28 +309,27 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
className = colormapName = screenName = visualName = useOption = NULL;
colormap = None;
- for (i = 2; i < argc; i += 2) {
- arg = argv[i];
- length = strlen(arg);
+ 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", strlen(arg)) == 0)
+ if ((c == 'c') && (strncmp(arg, "-class", length) == 0)
&& (length >= 3)) {
- className = argv[i+1];
+ className = Tcl_GetString(objv[i+1]);
} else if ((c == 'c')
- && (strncmp(arg, "-colormap", strlen(arg)) == 0)) {
- colormapName = argv[i+1];
+ && (strncmp(arg, "-colormap", length) == 0)) {
+ colormapName = Tcl_GetString(objv[i+1]);
} else if ((c == 's') && toplevel
- && (strncmp(arg, "-screen", strlen(arg)) == 0)) {
- screenName = argv[i+1];
+ && (strncmp(arg, "-screen", length) == 0)) {
+ screenName = Tcl_GetString(objv[i+1]);
} else if ((c == 'u') && toplevel
- && (strncmp(arg, "-use", strlen(arg)) == 0)) {
- useOption = argv[i+1];
+ && (strncmp(arg, "-use", length) == 0)) {
+ useOption = Tcl_GetString(objv[i+1]);
} else if ((c == 'v')
- && (strncmp(arg, "-visual", strlen(arg)) == 0)) {
- visualName = argv[i+1];
+ && (strncmp(arg, "-visual", length) == 0)) {
+ visualName = Tcl_GetString(objv[i+1]);
}
}
@@ -321,7 +352,8 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
screenName = (toplevel) ? "" : NULL;
}
if (tkwin != NULL) {
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], screenName);
+ new = Tk_CreateWindowFromPath(interp, tkwin, Tcl_GetString(objv[1]),
+ screenName);
} else {
/*
* We were called from Tk_Init; create a new application.
@@ -392,8 +424,8 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
framePtr->tkwin = new;
framePtr->display = Tk_Display(new);
framePtr->interp = interp;
- framePtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(new), FrameWidgetCmd,
+ framePtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(new), FrameWidgetObjCmd,
(ClientData) framePtr, FrameCmdDeletedProc);
framePtr->className = NULL;
framePtr->mask = (toplevel) ? TOPLEVEL : FRAME;
@@ -426,7 +458,7 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
mask |= ActivateMask;
}
Tk_CreateEventHandler(new, mask, FrameEventProc, (ClientData) framePtr);
- if (ConfigureFrame(interp, framePtr, argc-2, argv+2, 0) != TCL_OK) {
+ if (ConfigureFrame(interp, framePtr, objc-2, objv+2, 0) != TCL_OK) {
goto error;
}
if ((framePtr->isContainer)) {
@@ -441,7 +473,7 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
if (toplevel) {
Tcl_DoWhenIdle(MapFrame, (ClientData) framePtr);
}
- interp->result = Tk_PathName(new);
+ Tcl_SetResult(interp, Tk_PathName(new), TCL_STATIC);
return TCL_OK;
error:
@@ -454,7 +486,7 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
/*
*--------------------------------------------------------------
*
- * FrameWidgetCmd --
+ * FrameWidgetObjCmd --
*
* This procedure is invoked to process the Tcl command
* that corresponds to a frame widget. See the user
@@ -470,83 +502,87 @@ TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
*/
static int
-FrameWidgetCmd(clientData, interp, argc, argv)
+FrameWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about frame widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ static char *frameOptions[] = {
+ "cget", "configure", (char *) NULL
+ };
+ enum options {
+ FRAME_CGET, FRAME_CONFIGURE
+ };
register Frame *framePtr = (Frame *) clientData;
- int result;
+ int result = TCL_OK, index;
size_t length;
int c, i;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ 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);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
+ switch ((enum options) index) {
+ case FRAME_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
result = TCL_ERROR;
goto done;
}
result = Tk_ConfigureValue(interp, framePtr->tkwin, configSpecs,
- (char *) framePtr, argv[2], framePtr->mask);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
+ (char *) framePtr, Tcl_GetString(objv[2]), framePtr->mask);
+ break;
+ }
+ case FRAME_CONFIGURE: {
+ if (objc == 2) {
result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
(char *) framePtr, (char *) NULL, framePtr->mask);
- } else if (argc == 3) {
+ } else if (objc == 3) {
result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
- (char *) framePtr, argv[2], framePtr->mask);
+ (char *) framePtr, Tcl_GetString(objv[2]), framePtr->mask);
} else {
/*
* Don't allow the options -class, -colormap, -container,
* -newcmap, -screen, -use, or -visual to be changed.
*/
- for (i = 2; i < argc; i++) {
- length = strlen(argv[i]);
+ for (i = 2; i < objc; i++) {
+ char *arg = Tcl_GetStringFromObj(objv[i], (int *) &length);
if (length < 2) {
continue;
}
- c = argv[i][1];
- if (((c == 'c') && (strncmp(argv[i], "-class", length) == 0)
+ c = arg[1];
+ if (((c == 'c') && (strncmp(arg, "-class", length) == 0)
&& (length >= 2))
|| ((c == 'c') && (framePtr->mask == TOPLEVEL)
- && (strncmp(argv[i], "-colormap", length) == 0)
+ && (strncmp(arg, "-colormap", length) == 0)
&& (length >= 3))
|| ((c == 'c')
- && (strncmp(argv[i], "-container", length) == 0)
+ && (strncmp(arg, "-container", length) == 0)
&& (length >= 3))
|| ((c == 's') && (framePtr->mask == TOPLEVEL)
- && (strncmp(argv[i], "-screen", length) == 0))
+ && (strncmp(arg, "-screen", length) == 0))
|| ((c == 'u') && (framePtr->mask == TOPLEVEL)
- && (strncmp(argv[i], "-use", length) == 0))
+ && (strncmp(arg, "-use", length) == 0))
|| ((c == 'v') && (framePtr->mask == TOPLEVEL)
- && (strncmp(argv[i], "-visual", length) == 0))) {
- Tcl_AppendResult(interp, "can't modify ", argv[i],
+ && (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, argc-2, argv+2,
+ result = ConfigureFrame(interp, framePtr, objc-2, objv+2,
TK_CONFIG_ARGV_ONLY);
}
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be cget or configure", (char *) NULL);
- result = TCL_ERROR;
+ break;
+ }
}
done:
@@ -591,13 +627,13 @@ DestroyFrame(memPtr)
*
* ConfigureFrame --
*
- * This procedure is called to process an argv/argc list, plus
+ * 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 interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as text string, colors, font,
@@ -608,12 +644,12 @@ DestroyFrame(memPtr)
*/
static int
-ConfigureFrame(interp, framePtr, argc, argv, flags)
+ConfigureFrame(interp, framePtr, objc, objv, flags)
Tcl_Interp *interp; /* Used for error reporting. */
register Frame *framePtr; /* Information about widget; may or may
* not already have values for some fields. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
+ int objc; /* Number of valid entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
char *oldMenuName;
@@ -630,7 +666,8 @@ ConfigureFrame(interp, framePtr, argc, argv, flags)
}
if (Tk_ConfigureWidget(interp, framePtr->tkwin, configSpecs,
- argc, argv, (char *) framePtr, flags | framePtr->mask) != TCL_OK) {
+ objc, (char **) objv, (char *) framePtr,
+ flags | framePtr->mask | TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
@@ -694,7 +731,8 @@ DisplayFrame(clientData)
{
register Frame *framePtr = (Frame *) clientData;
register Tk_Window tkwin = framePtr->tkwin;
- GC gc;
+ void (* drawFunction) _ANSI_ARGS_((Tk_Window, Drawable, Tk_3DBorder,
+ int, int, int, int, int, int)) = Tk_Fill3DRectangle;
framePtr->flags &= ~REDRAW_PENDING;
if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)
@@ -703,7 +741,7 @@ DisplayFrame(clientData)
}
if (framePtr->border != NULL) {
- Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ drawFunction(tkwin, Tk_WindowId(tkwin),
framePtr->border, framePtr->highlightWidth,
framePtr->highlightWidth,
Tk_Width(tkwin) - 2*framePtr->highlightWidth,
@@ -711,15 +749,19 @@ DisplayFrame(clientData)
framePtr->borderWidth, framePtr->relief);
}
if (framePtr->highlightWidth != 0) {
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
if (framePtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(framePtr->highlightColorPtr,
+ fgGC = Tk_GCForColor(framePtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, framePtr->highlightWidth,
Tk_WindowId(tkwin));
} else {
- gc = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, framePtr->highlightWidth,
Tk_WindowId(tkwin));
}
- Tk_DrawFocusHighlight(tkwin, gc, framePtr->highlightWidth,
- Tk_WindowId(tkwin));
}
}
@@ -933,7 +975,11 @@ TkInstallFrameMenu(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);
}
}
+
diff --git a/tk/generic/tkGC.c b/tk/generic/tkGC.c
index 9d1c6949009..8ddcd391e4c 100644
--- a/tk/generic/tkGC.c
+++ b/tk/generic/tkGC.c
@@ -14,9 +14,6 @@
*/
#include "tkPort.h"
-#include "tk.h"
-
-/* CYGNUS LOCAL, for TkRegisterColorGC. */
#include "tkInt.h"
/*
@@ -32,46 +29,20 @@ typedef struct {
int refCount; /* Number of active uses of gc. */
Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting
* this structure). */
- /* CYGNUS LOCAL. */
- XColor *foreground; /* Foreground color. */
- XColor *background; /* Background color. */
} TkGC;
-/*
- * Hash table to map from a GC's values to a TkGC structure describing
- * a GC with those values (used by Tk_GetGC).
- */
-
-static Tcl_HashTable valueTable;
typedef struct {
XGCValues values; /* Desired values for GC. */
Display *display; /* Display for which GC is valid. */
int screenNum; /* screen number of display */
int depth; /* and depth for which GC is valid. */
- /* CYGNUS LOCAL. */
- XColor *foreground; /* Foreground color. */
- XColor *background; /* Background color. */
} ValueKey;
/*
- * Hash table for <display + GC> -> TkGC mapping. This table is used by
- * Tk_FreeGC.
- */
-
-static Tcl_HashTable idTable;
-typedef struct {
- Display *display; /* Display for which GC was allocated. */
- GC gc; /* X's identifier for GC. */
-} IdKey;
-
-static int initialized = 0; /* 0 means static structures haven't been
- * initialized yet. */
-
-/*
* Forward declarations for procedures defined in this file:
*/
-static void GCInit _ANSI_ARGS_((void));
+static void GCInit _ANSI_ARGS_((TkDisplay *dispPtr));
/*
*----------------------------------------------------------------------
@@ -95,11 +66,8 @@ static void GCInit _ANSI_ARGS_((void));
*----------------------------------------------------------------------
*/
-/* CYGNUS LOCAL: Rename this to Tk_GetGCColor. The new Tk_GetGC is
- below. */
-
GC
-Tk_GetGCColor(tkwin, valueMask, valuePtr, foreground, background)
+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
@@ -108,31 +76,18 @@ Tk_GetGCColor(tkwin, valueMask, valuePtr, foreground, background)
register XGCValues *valuePtr;
/* Values are specified here for bits set
* in valueMask. */
- /* CYGNUS LOCAL. */
- XColor *foreground; /* Foreground color. */
- XColor *background; /* Background color. */
{
ValueKey valueKey;
- IdKey idKey;
Tcl_HashEntry *valueHashPtr, *idHashPtr;
register TkGC *gcPtr;
int new;
Drawable d, freeDrawable;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- GCInit();
+ if (!dispPtr->gcInit) {
+ GCInit(dispPtr);
}
-#if !defined(__WIN32__) && !defined(_WIN32)
- /* CYGNUS LOCAL. We only care about special foreground and
- background colors on Windows. If we are on some other
- platform, just ignore them. If we don't do this, we may
- allocate an unnecessary GC if we have two colors with different
- names but the same pixel value. */
- foreground = NULL;
- background = NULL;
-#endif
-
/*
* Must zero valueKey at start to clear out pad bytes that may be
* part of structure on some systems.
@@ -263,12 +218,8 @@ Tk_GetGCColor(tkwin, valueMask, valuePtr, foreground, background)
valueKey.display = Tk_Display(tkwin);
valueKey.screenNum = Tk_ScreenNumber(tkwin);
valueKey.depth = Tk_Depth(tkwin);
-
- /* CYGNUS LOCAL. Set colors. */
- valueKey.foreground = foreground;
- valueKey.background = background;
-
- valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);
+ valueHashPtr = Tcl_CreateHashEntry(&dispPtr->gcValueTable,
+ (char *) &valueKey, &new);
if (!new) {
gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr);
gcPtr->refCount++;
@@ -305,9 +256,8 @@ Tk_GetGCColor(tkwin, valueMask, valuePtr, foreground, background)
gcPtr->display = valueKey.display;
gcPtr->refCount = 1;
gcPtr->valueHashPtr = valueHashPtr;
- idKey.display = valueKey.display;
- idKey.gc = gcPtr->gc;
- idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new);
+ idHashPtr = Tcl_CreateHashEntry(&dispPtr->gcIdTable,
+ (char *) gcPtr->gc, &new);
if (!new) {
panic("GC already registered in Tk_GetGC");
}
@@ -317,36 +267,8 @@ Tk_GetGCColor(tkwin, valueMask, valuePtr, foreground, background)
Tk_FreePixmap(valueKey.display, freeDrawable);
}
- /* CYGNUS LOCAL. Record and register the colors. */
- gcPtr->foreground = foreground;
- gcPtr->background = background;
- if (foreground != NULL) {
- TkRegisterColorGC(foreground, valueKey.display, gcPtr->gc,
- GCForeground);
- }
- if (background != NULL) {
- TkRegisterColorGC(background, valueKey.display, gcPtr->gc,
- GCBackground);
- }
-
return gcPtr->gc;
}
-
-/* CYGNUS LOCAL. Tk_GetGC now just calls Tk_GetGCColor. */
-
-GC
-Tk_GetGC(tkwin, valueMask, valuePtr)
- Tk_Window tkwin; /* Window in which GC will be used. */
- register unsigned long valueMask;
- /* 1 bits correspond to values specified
- * in *valuesPtr; other values are set
- * from defaults. */
- register XGCValues *valuePtr;
- /* Values are specified here for bits set
- * in valueMask. */
-{
- return Tk_GetGCColor(tkwin, valueMask, valuePtr, NULL, NULL);
-}
/*
*----------------------------------------------------------------------
@@ -371,33 +293,21 @@ Tk_FreeGC(display, gc)
Display *display; /* Display for which gc was allocated. */
GC gc; /* Graphics context to be released. */
{
- IdKey idKey;
Tcl_HashEntry *idHashPtr;
register TkGC *gcPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
- if (!initialized) {
+ if (!dispPtr->gcInit) {
panic("Tk_FreeGC called before Tk_GetGC");
}
- idKey.display = display;
- idKey.gc = gc;
- idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey);
+ 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) {
- /* CYGNUS LOCAL: Deregister the colors. */
- if (gcPtr->foreground != NULL) {
- TkDeregisterColorGC(gcPtr->foreground, gcPtr->gc,
- GCForeground);
- }
- if (gcPtr->background != NULL) {
- TkDeregisterColorGC(gcPtr->background, gcPtr->gc,
- GCBackground);
- }
-
Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
XFreeGC(gcPtr->display, gcPtr->gc);
Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
@@ -423,9 +333,10 @@ Tk_FreeGC(display, gc)
*/
static void
-GCInit()
+GCInit(dispPtr)
+ TkDisplay *dispPtr;
{
- initialized = 1;
- Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
- Tcl_InitHashTable(&idTable, sizeof(IdKey)/sizeof(int));
+ dispPtr->gcInit = 1;
+ Tcl_InitHashTable(&dispPtr->gcValueTable, sizeof(ValueKey)/sizeof(int));
+ Tcl_InitHashTable(&dispPtr->gcIdTable, TCL_ONE_WORD_KEYS);
}
diff --git a/tk/generic/tkGeometry.c b/tk/generic/tkGeometry.c
index 3545c4b7c4e..fcc33e33d55 100644
--- a/tk/generic/tkGeometry.c
+++ b/tk/generic/tkGeometry.c
@@ -53,19 +53,6 @@ typedef struct MaintainMaster {
} MaintainMaster;
/*
- * Hash table that maps from a master's Tk_Window token to a list of
- * Maintains for that master:
- */
-
-static Tcl_HashTable maintainHashTable;
-
-/*
- * Has maintainHashTable been initialized yet?
- */
-
-static int initialized = 0;
-
-/*
* Prototypes for static procedures in this file:
*/
@@ -261,10 +248,11 @@ Tk_MaintainGeometry(slave, master, x, y, width, height)
register MaintainSlave *slavePtr;
int new, map;
Tk_Window ancestor, parent;
+ TkDisplay *dispPtr = ((TkWindow *) master)->dispPtr;
- if (!initialized) {
- initialized = 1;
- Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS);
+ if (!dispPtr->geomInit) {
+ dispPtr->geomInit = 1;
+ Tcl_InitHashTable(&dispPtr->maintainHashTable, TCL_ONE_WORD_KEYS);
}
/*
@@ -273,7 +261,8 @@ Tk_MaintainGeometry(slave, master, x, y, width, height)
*/
parent = Tk_Parent(slave);
- hPtr = Tcl_CreateHashEntry(&maintainHashTable, (char *) master, &new);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->maintainHashTable,
+ (char *) master, &new);
if (!new) {
masterPtr = (MaintainMaster *) Tcl_GetHashValue(hPtr);
} else {
@@ -383,16 +372,17 @@ Tk_UnmaintainGeometry(slave, master)
MaintainMaster *masterPtr;
register MaintainSlave *slavePtr, *prevPtr;
Tk_Window ancestor;
+ TkDisplay *dispPtr = ((TkWindow *) slave)->dispPtr;
- if (!initialized) {
- initialized = 1;
- Tcl_InitHashTable(&maintainHashTable, TCL_ONE_WORD_KEYS);
+ 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(&maintainHashTable, (char *) master);
+ hPtr = Tcl_FindHashEntry(&dispPtr->maintainHashTable, (char *) master);
if (hPtr == NULL) {
return;
}
@@ -580,3 +570,4 @@ MaintainCheckProc(clientData)
}
}
}
+
diff --git a/tk/generic/tkGet.c b/tk/generic/tkGet.c
index 020a39005ae..f9df1acb1a2 100644
--- a/tk/generic/tkGet.c
+++ b/tk/generic/tkGet.c
@@ -8,7 +8,7 @@
* files.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -20,12 +20,64 @@
#include "tkPort.h"
/*
- * The hash table below is used to keep track of all the Tk_Uids created
- * so far.
+ * 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.
*/
-static Tcl_HashTable uidTable;
-static int initialized = 0;
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_HashTable uidTable;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * The following tables defines the string values for reliefs, which are
+ * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
+ */
+
+static char *anchorStrings[] = {"n", "ne", "e", "se", "s", "sw", "w", "nw",
+ "center", (char *) NULL};
+static char *justifyStrings[] = {"left", "right", "center", (char *) NULL};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetAnchorFromObj --
+ *
+ * Return a Tk_Anchor value based on the value of the objPtr.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * The object gets converted by Tcl_GetIndexFromObj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tcl_Obj *objPtr; /* The object we are trying to get the
+ * value from. */
+ Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that
+ * corresponds to the string value of
+ * objPtr. */
+{
+ int index, code;
+
+ code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0,
+ &index);
+ if (code == TCL_OK) {
+ *anchorPtr = (Tk_Anchor) index;
+ }
+ return code;
+}
/*
*--------------------------------------------------------------
@@ -39,7 +91,7 @@ static int initialized = 0;
* TCL_OK is returned, then everything went well and the
* position is stored at *anchorPtr; otherwise TCL_ERROR
* is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -148,14 +200,14 @@ Tk_NameOfAnchor(anchor)
*
* Tk_GetJoinStyle --
*
- * Given a string, return the corresponding Tk_JoinStyle.
+ * Given a string, return the corresponding Tk JoinStyle.
*
* Results:
* The return value is a standard Tcl return result. If
* TCL_OK is returned, then everything went well and the
* justification is stored at *joinPtr; otherwise
* TCL_ERROR is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -200,7 +252,7 @@ Tk_GetJoinStyle(interp, string, joinPtr)
*
* Tk_NameOfJoinStyle --
*
- * Given a Tk_JoinStyle, return the string that corresponds
+ * Given a Tk JoinStyle, return the string that corresponds
* to it.
*
* Results:
@@ -230,14 +282,14 @@ Tk_NameOfJoinStyle(join)
*
* Tk_GetCapStyle --
*
- * Given a string, return the corresponding Tk_CapStyle.
+ * Given a string, return the corresponding Tk CapStyle.
*
* Results:
* The return value is a standard Tcl return result. If
* TCL_OK is returned, then everything went well and the
* justification is stored at *capPtr; otherwise
* TCL_ERROR is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -282,7 +334,7 @@ Tk_GetCapStyle(interp, string, capPtr)
*
* Tk_NameOfCapStyle --
*
- * Given a Tk_CapStyle, return the string that corresponds
+ * Given a Tk CapStyle, return the string that corresponds
* to it.
*
* Results:
@@ -308,6 +360,43 @@ Tk_NameOfCapStyle(cap)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * 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 --
@@ -319,7 +408,7 @@ Tk_NameOfCapStyle(cap)
* TCL_OK is returned, then everything went well and the
* justification is stored at *justifyPtr; otherwise
* TCL_ERROR is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -417,13 +506,16 @@ 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 (!initialized) {
- Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS);
- initialized = 1;
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ tsdPtr->initialized = 1;
}
- return (Tk_Uid) Tcl_GetHashKey(&uidTable,
- Tcl_CreateHashEntry(&uidTable, string, &dummy));
+ return (Tk_Uid) Tcl_GetHashKey(tablePtr,
+ Tcl_CreateHashEntry(tablePtr, string, &dummy));
}
/*
@@ -439,7 +531,7 @@ Tk_GetUid(string)
* TCL_OK is returned, then everything went well and the
* screen distance is stored at *doublePtr; otherwise
* TCL_ERROR is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -515,7 +607,7 @@ Tk_GetScreenMM(interp, tkwin, string, doublePtr)
* TCL_OK is returned, then everything went well and the
* rounded pixel distance is stored at *intPtr; otherwise
* TCL_ERROR is returned and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -529,13 +621,56 @@ Tk_GetPixels(interp, tkwin, string, intPtr)
Tk_Window tkwin; /* Window whose screen determines conversion
* from centimeters and other absolute
* units. */
- char *string; /* String describing a justification style. */
+ 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(string, &end);
+ d = strtod((char *) string, &end);
if (end == string) {
error:
Tcl_AppendResult(interp, "bad screen distance \"", string,
@@ -577,10 +712,9 @@ Tk_GetPixels(interp, tkwin, string, intPtr)
if (*end != 0) {
goto error;
}
- if (d < 0) {
- *intPtr = (int) (d - 0.5);
- } else {
- *intPtr = (int) (d + 0.5);
- }
+ *doublePtr = d;
return TCL_OK;
}
+
+
+
diff --git a/tk/generic/tkGrab.c b/tk/generic/tkGrab.c
index 8be4b9f24f8..1ff6b8e1bcf 100644
--- a/tk/generic/tkGrab.c
+++ b/tk/generic/tkGrab.c
@@ -4,7 +4,7 @@
* This file provides procedures that implement grabs for Tk.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -15,6 +15,10 @@
#include "tkPort.h"
#include "tkInt.h"
+#if !defined(__WIN32__) && !defined(MAC_TCL)
+#include "tkUnixInt.h"
+#endif
+
/*
* The grab state machine has four states: ungrabbed, button pressed,
* grabbed, and button pressed while grabbed. In addition, there are
@@ -238,10 +242,11 @@ Tk_GrabCmd(clientData, interp, argc, argv)
}
dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (dispPtr->eventualGrabWinPtr != NULL) {
- interp->result = dispPtr->eventualGrabWinPtr->pathName;
+ Tcl_SetResult(interp, dispPtr->eventualGrabWinPtr->pathName,
+ TCL_STATIC);
}
} else {
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
if (dispPtr->eventualGrabWinPtr != NULL) {
Tcl_AppendElement(interp,
@@ -303,11 +308,11 @@ Tk_GrabCmd(clientData, interp, argc, argv)
}
dispPtr = winPtr->dispPtr;
if (dispPtr->eventualGrabWinPtr != winPtr) {
- interp->result = "none";
+ Tcl_SetResult(interp, "none", TCL_STATIC);
} else if (dispPtr->grabFlags & GRAB_GLOBAL) {
- interp->result = "global";
+ Tcl_SetResult(interp, "global", TCL_STATIC);
} else {
- interp->result = "local";
+ Tcl_SetResult(interp, "local", TCL_STATIC);
}
} else {
Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
@@ -329,7 +334,7 @@ Tk_GrabCmd(clientData, interp, argc, argv)
* Results:
* A standard Tcl result is returned. TCL_OK is the normal return
* value; if the grab could not be set then TCL_ERROR is returned
- * and interp->result will hold an error message.
+ * and the interp's result will hold an error message.
*
* Side effects:
* Once this call completes successfully, no window outside the
@@ -366,7 +371,8 @@ Tk_Grab(interp, tkwin, grabGlobal)
}
if (dispPtr->eventualGrabWinPtr->mainPtr != winPtr->mainPtr) {
alreadyGrabbed:
- interp->result = "grab failed: another application has grab";
+ Tcl_SetResult(interp, "grab failed: another application has grab",
+ TCL_STATIC);
return TCL_ERROR;
}
Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
@@ -432,15 +438,18 @@ Tk_Grab(interp, tkwin, grabGlobal)
if (grabResult != 0) {
grabError:
if (grabResult == GrabNotViewable) {
- interp->result = "grab failed: window not viewable";
+ Tcl_SetResult(interp, "grab failed: window not viewable",
+ TCL_STATIC);
} else if (grabResult == AlreadyGrabbed) {
goto alreadyGrabbed;
} else if (grabResult == GrabFrozen) {
- interp->result = "grab failed: keyboard or pointer frozen";
+ Tcl_SetResult(interp,
+ "grab failed: keyboard or pointer frozen", TCL_STATIC);
} else if (grabResult == GrabInvalidTime) {
- interp->result = "grab failed: invalid time";
+ Tcl_SetResult(interp, "grab failed: invalid time",
+ TCL_STATIC);
} else {
- char msg[100];
+ char msg[64 + TCL_INTEGER_SPACE];
sprintf(msg, "grab failed for unknown reason (code %d)",
grabResult);
@@ -1533,3 +1542,4 @@ TkGrabState(winPtr)
return TkPositionInTree(winPtr, grabWinPtr);
}
+
diff --git a/tk/generic/tkGrid.c b/tk/generic/tkGrid.c
index e78eb7e3b78..def4a434d49 100644
--- a/tk/generic/tkGrid.c
+++ b/tk/generic/tkGrid.c
@@ -222,14 +222,6 @@ typedef struct Gridder {
#define DONT_PROPAGATE 2
/*
- * Hash table used to map from Tk_Window tokens to corresponding
- * Grid structures:
- */
-
-static Tcl_HashTable gridHashTable;
-static int initialized = 0;
-
-/*
* Prototypes for procedures used only in this file:
*/
@@ -314,6 +306,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
int endX, endY; /* last column/row in the layout */
int x=0, y=0; /* starting pixels for this bounding box */
int width, height; /* size of the bounding box */
+ char buf[TCL_INTEGER_SPACE * 4];
if (argc!=3 && argc != 5 && argc != 7) {
Tcl_AppendResult(interp, "wrong number of arguments: ",
@@ -351,7 +344,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
gridPtr = masterPtr->masterDataPtr;
if (gridPtr == NULL) {
- sprintf(interp->result, "%d %d %d %d",0,0,0,0);
+ Tcl_SetResult(interp, "0 0 0 0", TCL_STATIC);
return(TCL_OK);
}
@@ -360,7 +353,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
if ((endX == 0) || (endY == 0)) {
- sprintf(interp->result, "%d %d %d %d",0,0,0,0);
+ Tcl_SetResult(interp, "0 0 0 0", TCL_STATIC);
return(TCL_OK);
}
if (argc == 3) {
@@ -406,8 +399,9 @@ Tk_GridCmd(clientData, interp, argc, argv)
height = gridPtr->rowPtr[row2].offset - y;
}
- sprintf(interp->result, "%d %d %d %d",
- x + gridPtr->startX, y + gridPtr->startY, width, height);
+ sprintf(buf, "%d %d %d %d", x + gridPtr->startX, y + gridPtr->startY,
+ width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
if (argv[2][0] != '.') {
Tcl_AppendResult(interp, "bad argument \"", argv[2],
@@ -440,6 +434,9 @@ Tk_GridCmd(clientData, interp, argc, argv)
slavePtr->padX = slavePtr->padY = 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;
}
@@ -456,7 +453,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
} else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
register Gridder *slavePtr;
Tk_Window slave;
- char buffer[70];
+ char buffer[64 + TCL_INTEGER_SPACE * 4];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -469,7 +466,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
}
slavePtr = GetGrid(slave);
if (slavePtr->masterPtr == NULL) {
- interp->result[0] = '\0';
+ Tcl_ResetResult(interp);
return TCL_OK;
}
@@ -491,6 +488,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
int x, y; /* Offset in pixels, from edge of parent. */
int i, j; /* Corresponding column and row indeces. */
int endX, endY; /* end of grid */
+ char buf[TCL_INTEGER_SPACE * 2];
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -512,7 +510,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
masterPtr = GetGrid(master);
if (masterPtr->masterDataPtr == NULL) {
- sprintf(interp->result, "%d %d", -1, -1);
+ Tcl_SetResult(interp, "-1 -1", TCL_STATIC);
return TCL_OK;
}
gridPtr = masterPtr->masterDataPtr;
@@ -524,7 +522,7 @@ Tk_GridCmd(clientData, interp, argc, argv)
*/
while (masterPtr->flags & REQUESTED_RELAYOUT) {
- Tk_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr);
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr);
ArrangeGrid ((ClientData) masterPtr);
}
SetGridSize(masterPtr);
@@ -551,7 +549,8 @@ Tk_GridCmd(clientData, interp, argc, argv)
}
}
- sprintf(interp->result, "%d %d", i, j);
+ sprintf(buf, "%d %d", i, j);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) {
Tk_Window master;
int propagate;
@@ -568,14 +567,23 @@ Tk_GridCmd(clientData, interp, argc, argv)
}
masterPtr = GetGrid(master);
if (argc == 3) {
- interp->result = (masterPtr->flags & DONT_PROPAGATE) ? "0" : "1";
+ Tcl_SetResult(interp,
+ ((masterPtr->flags & DONT_PROPAGATE) ? "0" : "1"),
+ TCL_STATIC);
return TCL_OK;
}
if (Tcl_GetBoolean(interp, argv[3], &propagate) != TCL_OK) {
return TCL_ERROR;
}
+
+ /* Only request a relayout if the propagation bit changes */
+
if ((!propagate) ^ (masterPtr->flags&DONT_PROPAGATE)) {
- masterPtr->flags ^= DONT_PROPAGATE;
+ if (propagate) {
+ masterPtr->flags &= ~DONT_PROPAGATE;
+ } else {
+ masterPtr->flags |= DONT_PROPAGATE;
+ }
/*
* Re-arrange the master to allow new geometry information to
@@ -606,13 +614,16 @@ Tk_GridCmd(clientData, interp, argc, argv)
masterPtr = GetGrid(master);
if (masterPtr->masterDataPtr != NULL) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
SetGridSize(masterPtr);
gridPtr = masterPtr->masterDataPtr;
- sprintf(interp->result, "%d %d",
- MAX(gridPtr->columnEnd, gridPtr->columnMax),
- MAX(gridPtr->rowEnd, gridPtr->rowMax));
+ sprintf(buf, "%d %d",
+ MAX(gridPtr->columnEnd, gridPtr->columnMax),
+ MAX(gridPtr->rowEnd, gridPtr->rowMax));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else {
- sprintf(interp->result, "%d %d",0, 0);
+ Tcl_SetResult(interp, "0 0", TCL_STATIC);
}
} else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)
&& (length > 1)) {
@@ -754,12 +765,16 @@ Tk_GridCmd(clientData, interp, argc, argv)
Tcl_Free((char *)argvPtr);
}
if ((argc == 4) && (ok == TCL_OK)) {
- sprintf(interp->result,"-minsize %d -pad %d -weight %d",
+ char buf[64 + TCL_INTEGER_SPACE * 3];
+
+ sprintf(buf, "-minsize %d -pad %d -weight %d",
slotPtr[slot].minSize,slotPtr[slot].pad,
slotPtr[slot].weight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return (TCL_OK);
} else if (argc == 4) {
- sprintf(interp->result,"-minsize %d -pad %d -weight %d", 0,0,0);
+ Tcl_SetResult(interp, "-minsize 0 -pad 0 -weight 0",
+ TCL_STATIC);
return (TCL_OK);
}
@@ -780,8 +795,12 @@ Tk_GridCmd(clientData, interp, argc, argv)
}
if (strncmp(argv[i], "-minsize", length) == 0) {
if (argc == 5) {
- int value = ok == TCL_OK ? slotPtr[slot].minSize : 0;
- sprintf(interp->result,"%d",value);
+ char buf[TCL_INTEGER_SPACE];
+ int value;
+
+ value = (ok == TCL_OK) ? slotPtr[slot].minSize : 0;
+ sprintf(buf, "%d", value);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (Tk_GetPixels(interp, master, argv[i+1], &size)
!= TCL_OK) {
Tcl_Free((char *)argvPtr);
@@ -793,8 +812,12 @@ Tk_GridCmd(clientData, interp, argc, argv)
else if (strncmp(argv[i], "-weight", length) == 0) {
int wt;
if (argc == 5) {
- int value = ok == TCL_OK ? slotPtr[slot].weight : 0;
- sprintf(interp->result,"%d",value);
+ char buf[TCL_INTEGER_SPACE];
+ int value;
+
+ value = (ok == TCL_OK) ? slotPtr[slot].weight : 0;
+ sprintf(buf, "%d", value);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (Tcl_GetInt(interp, argv[i+1], &wt) != TCL_OK) {
Tcl_Free((char *)argvPtr);
return TCL_ERROR;
@@ -809,8 +832,12 @@ Tk_GridCmd(clientData, interp, argc, argv)
}
else if (strncmp(argv[i], "-pad", length) == 0) {
if (argc == 5) {
- int value = ok == TCL_OK ? slotPtr[slot].pad : 0;
- sprintf(interp->result,"%d",value);
+ char buf[TCL_INTEGER_SPACE];
+ int value;
+
+ value = (ok == TCL_OK) ? slotPtr[slot].pad : 0;
+ sprintf(buf, "%d", value);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if (Tk_GetPixels(interp, master, argv[i+1], &size)
!= TCL_OK) {
Tcl_Free((char *)argvPtr);
@@ -1411,7 +1438,7 @@ ResolveConstraints(masterPtr, slotType, maxOffset)
gridCount = MAX(constraintCount,slotCount);
if (gridCount >= TYPICAL_SIZE) {
- layoutPtr = (GridLayout *) Tcl_Alloc(sizeof(GridLayout) * (1+gridCount));
+ layoutPtr = (GridLayout *) ckalloc(sizeof(GridLayout) * (1+gridCount));
} else {
layoutPtr = layoutData;
}
@@ -1714,10 +1741,11 @@ GetGrid(tkwin)
register Gridder *gridPtr;
Tcl_HashEntry *hPtr;
int new;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- initialized = 1;
- Tcl_InitHashTable(&gridHashTable, TCL_ONE_WORD_KEYS);
+ if (!dispPtr->gridInit) {
+ Tcl_InitHashTable(&dispPtr->gridHashTable, TCL_ONE_WORD_KEYS);
+ dispPtr->gridInit = 1;
}
/*
@@ -1725,11 +1753,11 @@ GetGrid(tkwin)
* then create a new one.
*/
- hPtr = Tcl_CreateHashEntry(&gridHashTable, (char *) tkwin, &new);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->gridHashTable, (char *) tkwin, &new);
if (!new) {
return (Gridder *) Tcl_GetHashValue(hPtr);
}
- gridPtr = (Gridder *) Tcl_Alloc(sizeof(Gridder));
+ gridPtr = (Gridder *) ckalloc(sizeof(Gridder));
gridPtr->tkwin = tkwin;
gridPtr->masterPtr = NULL;
gridPtr->masterDataPtr = NULL;
@@ -1852,7 +1880,7 @@ CheckSlotData(masterPtr, slot, slotType, checkOnly)
int newNumSlot = slot + PREALLOC ;
size_t oldSize = numSlot * sizeof(SlotInfo) ;
size_t newSize = newNumSlot * sizeof(SlotInfo) ;
- SlotInfo *new = (SlotInfo *) Tcl_Alloc(newSize);
+ SlotInfo *new = (SlotInfo *) ckalloc(newSize);
SlotInfo *old = (slotType == ROW) ?
masterPtr->masterDataPtr->rowPtr :
masterPtr->masterDataPtr->columnPtr;
@@ -1904,19 +1932,19 @@ InitMasterData(masterPtr)
size_t size;
if (masterPtr->masterDataPtr == NULL) {
GridMaster *gridPtr = masterPtr->masterDataPtr =
- (GridMaster *) Tcl_Alloc(sizeof(GridMaster));
+ (GridMaster *) ckalloc(sizeof(GridMaster));
size = sizeof(SlotInfo) * TYPICAL_SIZE;
gridPtr->columnEnd = 0;
gridPtr->columnMax = 0;
- gridPtr->columnPtr = (SlotInfo *) Tcl_Alloc(size);
- gridPtr->columnSpace = 0;
+ gridPtr->columnPtr = (SlotInfo *) ckalloc(size);
gridPtr->columnSpace = TYPICAL_SIZE;
gridPtr->rowEnd = 0;
gridPtr->rowMax = 0;
- gridPtr->rowPtr = (SlotInfo *) Tcl_Alloc(size);
- gridPtr->rowSpace = 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);
@@ -1986,7 +2014,7 @@ Unlink(slavePtr)
*
* DestroyGrid --
*
- * This procedure is invoked by Tk_EventuallyFree or Tcl_Release
+ * 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
@@ -2045,6 +2073,7 @@ GridStructureProc(clientData, 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)) {
@@ -2072,13 +2101,13 @@ GridStructureProc(clientData, eventPtr)
nextPtr = gridPtr2->nextPtr;
gridPtr2->nextPtr = NULL;
}
- Tcl_DeleteHashEntry(Tcl_FindHashEntry(&gridHashTable,
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->gridHashTable,
(char *) gridPtr->tkwin));
if (gridPtr->flags & REQUESTED_RELAYOUT) {
- Tk_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
+ Tcl_CancelIdleCall(ArrangeGrid, (ClientData) gridPtr);
}
gridPtr->tkwin = NULL;
- Tk_EventuallyFree((ClientData) gridPtr, DestroyGrid);
+ Tcl_EventuallyFree((ClientData) gridPtr, DestroyGrid);
} else if (eventPtr->type == MapNotify) {
if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
gridPtr->flags |= REQUESTED_RELAYOUT;
@@ -2107,7 +2136,7 @@ GridStructureProc(clientData, eventPtr)
*
* Results:
* TCL_OK is returned if all went well. Otherwise, TCL_ERROR is
- * returned and interp->result is set to contain an error message.
+ * returned and the interp's result is set to contain an error message.
*
* Side effects:
* Slave windows get taken over by the grid.
@@ -2281,7 +2310,8 @@ ConfigureSlaves(interp, tkwin, argc, argv)
return TCL_ERROR;
}
if (other == slave) {
- sprintf(interp->result,"Window can't be managed in itself");
+ Tcl_SetResult(interp, "Window can't be managed in itself",
+ TCL_STATIC);
return TCL_ERROR;
}
masterPtr = GetGrid(other);
@@ -2482,6 +2512,7 @@ ConfigureSlaves(interp, tkwin, argc, argv)
return TCL_ERROR;
}
+ /* Count the number of consecutive ^'s starting from this position */
for (width=1; width+j < numWindows && *argv[j+width] == REL_VERT;
width++) {
/* Null Body */
@@ -2494,7 +2525,7 @@ ConfigureSlaves(interp, tkwin, argc, argv)
if (lastWindow == NULL) {
if (masterPtr->masterDataPtr != NULL) {
SetGridSize(masterPtr);
- lastRow = masterPtr->masterDataPtr->rowEnd - 1;
+ lastRow = masterPtr->masterDataPtr->rowEnd - 2;
} else {
lastRow = 0;
}
@@ -2502,27 +2533,30 @@ ConfigureSlaves(interp, tkwin, argc, argv)
} else {
other = Tk_NameToWindow(interp, lastWindow, tkwin);
otherPtr = GetGrid(other);
- lastRow = otherPtr->row;
+ lastRow = otherPtr->row + otherPtr->numRows - 2;
lastColumn = otherPtr->column + otherPtr->numCols;
}
for (match=0, slavePtr = masterPtr->slavePtr; slavePtr != NULL;
slavePtr = slavePtr->nextPtr) {
- if (slavePtr->numCols == width
- && slavePtr->column == lastColumn
- && slavePtr->row + slavePtr->numRows == lastRow) {
- slavePtr->numRows++;
- match++;
+ 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);
+ break;
+ }
}
- lastWindow = Tk_PathName(slavePtr->tkwin);
}
if (!match) {
Tcl_AppendResult(interp, "can't find slave to extend with \"^\".",
(char *) NULL);
return TCL_ERROR;
}
- j += width - 1;
+/* j += width - 1; */
}
if (masterPtr == NULL) {
@@ -2613,3 +2647,5 @@ StringToSticky(string)
}
return sticky;
}
+
+
diff --git a/tk/generic/tkImage.c b/tk/generic/tkImage.c
index 74ed3bc91b2..778081002a9 100644
--- a/tk/generic/tkImage.c
+++ b/tk/generic/tkImage.c
@@ -6,7 +6,7 @@
* widgets.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -71,12 +71,13 @@ typedef struct ImageMaster {
* derived from this name. */
} ImageMaster;
-/*
- * The following variable points to the first in a list of all known
- * image types.
- */
-
-static Tk_ImageType *imageTypeList = NULL;
+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:
@@ -87,7 +88,7 @@ static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
/*
*----------------------------------------------------------------------
*
- * Tk_CreateImageType --
+ * 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.
@@ -104,20 +105,37 @@ static void DeleteImage _ANSI_ARGS_((ImageMaster *masterPtr));
*/
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. */
{
- typePtr->nextPtr = imageTypeList;
- imageTypeList = typePtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ typePtr->nextPtr = tsdPtr->imageTypeList;
+ tsdPtr->imageTypeList = typePtr;
}
/*
*----------------------------------------------------------------------
*
- * Tk_ImageCmd --
+ * Tk_ImageObjCmd --
*
* This procedure is invoked to process the "image" Tcl command.
* See the user documentation for details on what it does.
@@ -132,210 +150,263 @@ Tk_CreateImageType(typePtr)
*/
int
-Tk_ImageCmd(clientData, interp, argc, objv)
+Tk_ImageObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
+ int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument strings. */
{
+ static char *imageOptions[] = {
+ "create", "delete", "height", "names", "type", "types", "width",
+ (char *) NULL
+ };
+ enum options {
+ IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_NAMES,
+ IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH
+ };
TkWindow *winPtr = (TkWindow *) clientData;
- int c, i, new, firstOption;
- size_t length;
+ int i, new, firstOption, index;
Tk_ImageType *typePtr;
ImageMaster *masterPtr;
Image *imagePtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
- char idString[30], *name;
- static int id = 0;
-
- static char **argv = NULL;
- if (argv) ckfree((char *) argv);
- argv = (char **) ckalloc(argc * sizeof(char *));
- for (i = 0; i < argc; i++) {
- argv[i]=Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ 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 (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?args?\"", (char *) NULL);
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], imageOptions, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " create type ?name? ?options?\"", (char *) NULL);
- return TCL_ERROR;
- }
- c = argv[2][0];
+ 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.
- */
+ /*
+ * Look up the image type.
+ */
- for (typePtr = imageTypeList; typePtr != NULL;
- typePtr = typePtr->nextPtr) {
- if ((c == typePtr->name[0])
- && (strcmp(argv[2], typePtr->name) == 0)) {
- break;
+ 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;
}
- }
- if (typePtr == NULL) {
- Tcl_AppendResult(interp, "image type \"", argv[2],
- "\" doesn't exist", (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * Figure out a name to use for the new image.
- */
- if ((argc == 3) || (argv[3][0] == '-')) {
- id++;
- sprintf(idString, "image%d", id);
- name = idString;
- firstOption = 3;
- } else {
- name = argv[3];
- firstOption = 4;
- }
+ /*
+ * Figure out a name to use for the new image.
+ */
- /*
- * Create the data structure 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;
+ }
- hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable, name, &new);
- if (new) {
- masterPtr = (ImageMaster *) ckalloc(sizeof(ImageMaster));
- masterPtr->typePtr = NULL;
- masterPtr->masterData = NULL;
- masterPtr->width = masterPtr->height = 1;
- masterPtr->tablePtr = &winPtr->mainPtr->imageTable;
- masterPtr->hPtr = hPtr;
- masterPtr->instancePtr = NULL;
- Tcl_SetHashValue(hPtr, masterPtr);
- } else {
/*
- * An image already exists by this name. Disconnect the
- * instances from the master.
+ * Create the data structure for the new image.
*/
- 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);
+ hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable,
+ name, &new);
+ if (new) {
+ masterPtr = (ImageMaster *) ckalloc(sizeof(ImageMaster));
masterPtr->typePtr = NULL;
+ masterPtr->masterData = NULL;
+ masterPtr->width = masterPtr->height = 1;
+ masterPtr->tablePtr = &winPtr->mainPtr->imageTable;
+ masterPtr->hPtr = hPtr;
+ masterPtr->instancePtr = NULL;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ } else {
+ /*
+ * An image already exists by this name. Disconnect the
+ * instances from the master.
+ */
+
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*masterPtr->typePtr->freeProc)(
+ imagePtr->instanceData, imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData,
+ 0, 0, masterPtr->width, masterPtr->height,
+ masterPtr->width, masterPtr->height);
+ }
+ (*masterPtr->typePtr->deleteProc)(masterPtr->masterData);
+ masterPtr->typePtr = NULL;
+ }
}
- }
- /*
- * Call the image type manager so that it can perform its own
- * initialization, then re-"get" for any existing instances of
- * the image.
- */
+ /*
+ * Call the image type manager so that it can perform its own
+ * initialization, then re-"get" for any existing instances of
+ * the image.
+ */
- if ((*typePtr->createProc)(interp, name, argc-firstOption,
- objv+firstOption, typePtr, (Tk_ImageMaster) masterPtr,
- &masterPtr->masterData) != TCL_OK) {
- DeleteImage(masterPtr);
- return TCL_ERROR;
+ 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;
+ }
+ if ((*typePtr->createProc)(interp, name, objc,
+ args, typePtr, (Tk_ImageMaster) masterPtr,
+ &masterPtr->masterData) != TCL_OK) {
+ DeleteImage(masterPtr);
+ if (oldimage) {
+ ckfree((char *) args);
+ }
+ return TCL_ERROR;
+ }
+ 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;
}
- masterPtr->typePtr = typePtr;
- for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
- imagePtr = imagePtr->nextPtr) {
- imagePtr->instanceData = (*typePtr->getProc)(
- imagePtr->tkwin, masterPtr->masterData);
+ 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;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ DeleteImage(masterPtr);
+ }
+ break;
}
- Tcl_AppendResult(interp, Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), (char *) NULL);
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- for (i = 2; i < argc; i++) {
- hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[i]);
+ 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 \"", argv[i],
- "\" doesn't exist", (char *) NULL);
+ Tcl_AppendResult(interp, "image \"", arg,
+ "\" doesn't exist", (char *) NULL);
return TCL_ERROR;
}
masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
- DeleteImage(masterPtr);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height);
+ break;
}
- } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " height name\"", (char *) NULL);
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
- if (hPtr == NULL) {
- Tcl_AppendResult(interp, "image \"", argv[2],
- "\" doesn't exist", (char *) NULL);
- return TCL_ERROR;
- }
- masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height);
- } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " names\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
- hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(
+ case IMAGE_NAMES: {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(
&winPtr->mainPtr->imageTable, hPtr));
+ }
+ break;
}
- } else if ((c == 't') && (strcmp(argv[1], "type") == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " type name\"", (char *) NULL);
- return TCL_ERROR;
- }
- hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
- if (hPtr == NULL) {
- Tcl_AppendResult(interp, "image \"", argv[2],
- "\" doesn't exist", (char *) NULL);
- return TCL_ERROR;
- }
- masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
- if (masterPtr->typePtr != NULL) {
- Tcl_AppendResult(interp, masterPtr->typePtr->name, (char *) NULL);
- }
- } else if ((c == 't') && (strcmp(argv[1], "types") == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " types\"", (char *) NULL);
- return TCL_ERROR;
- }
- for (typePtr = imageTypeList; typePtr != NULL;
- typePtr = typePtr->nextPtr) {
- Tcl_AppendElement(interp, typePtr->name);
+ 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;
}
- } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " width name\"", (char *) NULL);
- return TCL_ERROR;
+ 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;
}
- hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, argv[2]);
- if (hPtr == NULL) {
- Tcl_AppendResult(interp, "image \"", argv[2],
- "\" doesn't exist", (char *) NULL);
- return TCL_ERROR;
+ 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;
}
- masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
- Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->width);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be create, delete, height, names, type, types,",
- " or width", (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
}
@@ -379,9 +450,9 @@ Tk_ImageChanged(imageMaster, x, y, width, height, imageWidth,
masterPtr->width = imageWidth;
masterPtr->height = imageHeight;
for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
- imagePtr = imagePtr->nextPtr) {
+ imagePtr = imagePtr->nextPtr) {
(*imagePtr->changeProc)(imagePtr->widgetClientData, x, y,
- width, height, imageWidth, imageHeight);
+ width, height, imageWidth, imageHeight);
}
}
@@ -422,7 +493,7 @@ Tk_NameOfImage(imageMaster)
* Results:
* The return value is a token for the image. If there is no image
* by the given name, then NULL is returned and an error message is
- * left in interp->result.
+ * left in the interp's result.
*
* Side effects:
* Tk records the fact that the widget is using the image, and
@@ -537,6 +608,101 @@ Tk_FreeImage(image)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -793,3 +959,41 @@ Tk_GetImageMasterData(interp, name, typePtrPtr)
*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_IsTopLevel(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/tk/generic/tkImgBmap.c b/tk/generic/tkImgBmap.c
index fcdc990ed82..47eacf2f560 100644
--- a/tk/generic/tkImgBmap.c
+++ b/tk/generic/tkImgBmap.c
@@ -5,6 +5,7 @@
*
* 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.
@@ -91,6 +92,10 @@ static void ImgBmapDisplay _ANSI_ARGS_((ClientData clientData,
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 */
@@ -99,6 +104,7 @@ Tk_ImageType tkBitmapImageType = {
ImgBmapDisplay, /* displayProc */
ImgBmapFree, /* freeProc */
ImgBmapDelete, /* deleteProc */
+ ImgBmapPostscript, /* postscriptProc */
(Tk_ImageType *) NULL /* nextPtr */
};
@@ -149,13 +155,13 @@ typedef struct ParseInfo {
*/
static int ImgBmapCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ 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, char **argv,
+ BitmapMaster *masterPtr, int argc, Tcl_Obj *CONST objv[],
int flags));
static int NextBitmapWord _ANSI_ARGS_((ParseInfo *parseInfoPtr));
@@ -178,12 +184,12 @@ static int NextBitmapWord _ANSI_ARGS_((ParseInfo *parseInfoPtr));
/* ARGSUSED */
static int
-ImgBmapCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
+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 objv[]; /* Argument objects for options (doesn't
+ 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
@@ -192,13 +198,11 @@ ImgBmapCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
* it will be returned in later callbacks. */
{
BitmapMaster *masterPtr;
- char **argv;
- int i;
masterPtr = (BitmapMaster *) ckalloc(sizeof(BitmapMaster));
masterPtr->tkMaster = master;
masterPtr->interp = interp;
- masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgBmapCmd,
+ masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgBmapCmd,
(ClientData) masterPtr, ImgBmapCmdDeletedProc);
masterPtr->width = masterPtr->height = 0;
masterPtr->data = NULL;
@@ -211,20 +215,10 @@ ImgBmapCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
masterPtr->maskDataString = NULL;
masterPtr->instancePtr = NULL;
- /*
- * Convert the objv arguments into string equivalent.
- * A proper conversion to object format will need to be done in the future
- */
- argv = (char **) ckalloc(argc * sizeof(char *));
- for (i = 0; i < argc; i++) {
- argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
- }
if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
ImgBmapDelete((ClientData) masterPtr);
- ckfree((char *) argv);
return TCL_ERROR;
}
- ckfree((char *) argv);
*clientDataPtr = (ClientData) masterPtr;
return TCL_OK;
}
@@ -240,7 +234,7 @@ ImgBmapCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
*
* Results:
* A standard Tcl return value. If TCL_ERROR is returned then
- * an error message is left in masterPtr->interp->result.
+ * an error message is left in the masterPtr->interp's result.
*
* Side effects:
* Existing instances of the image will be redisplayed to match
@@ -250,22 +244,30 @@ ImgBmapCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
*/
static int
-ImgBmapConfigureMaster(masterPtr, argc, argv, flags)
+ImgBmapConfigureMaster(masterPtr, objc, objv, flags)
BitmapMaster *masterPtr; /* Pointer to data structure describing
* overall bitmap image to (reconfigure). */
- int argc; /* Number of entries in argv. */
- char **argv; /* Pairs of configuration options for image. */
+ int 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;
+ char **argv = (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, argc, argv, (char *) masterPtr, flags)
+ 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
@@ -291,7 +293,8 @@ ImgBmapConfigureMaster(masterPtr, argc, argv, flags)
if ((masterPtr->maskFileString != NULL)
|| (masterPtr->maskDataString != NULL)) {
if (masterPtr->data == NULL) {
- masterPtr->interp->result = "can't have mask without bitmap";
+ Tcl_SetResult(masterPtr->interp, "can't have mask without bitmap",
+ TCL_STATIC);
return TCL_ERROR;
}
masterPtr->maskData = TkGetBitmapData(masterPtr->interp,
@@ -304,7 +307,8 @@ ImgBmapConfigureMaster(masterPtr, argc, argv, flags)
|| (maskHeight != masterPtr->height)) {
ckfree(masterPtr->maskData);
masterPtr->maskData = NULL;
- masterPtr->interp->result = "bitmap and mask have different sizes";
+ Tcl_SetResult(masterPtr->interp,
+ "bitmap and mask have different sizes", TCL_STATIC);
return TCL_ERROR;
}
}
@@ -353,6 +357,7 @@ ImgBmapConfigureInstance(instancePtr)
XGCValues gcValues;
GC gc;
unsigned int mask;
+ Pixmap oldMask;
/*
* For each of the options in masterPtr, translate the string
@@ -395,10 +400,14 @@ ImgBmapConfigureInstance(instancePtr)
(unsigned) masterPtr->height);
}
- if (instancePtr->mask != None) {
- Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->mask);
- instancePtr->mask = None;
- }
+ /*
+ * 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),
@@ -406,6 +415,9 @@ ImgBmapConfigureInstance(instancePtr)
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;
@@ -422,8 +434,7 @@ ImgBmapConfigureInstance(instancePtr)
gcValues.clip_mask = instancePtr->bitmap;
mask |= GCClipMask;
}
- gc = Tk_GetGCColor(instancePtr->tkwin, mask, &gcValues,
- instancePtr->fg, instancePtr->bg);
+ gc = Tk_GetGC(instancePtr->tkwin, mask, &gcValues);
} else {
gc = None;
}
@@ -465,7 +476,7 @@ ImgBmapConfigureInstance(instancePtr)
* *heightPtr. *hotXPtr and *hotYPtr are set to the bitmap
* hotspot if one is defined, otherwise they are set to -1, -1.
* If an error occurred, NULL is returned and an error message is
- * left in interp->result.
+ * left in the interp's result.
*
* Side effects:
* A bitmap is created.
@@ -515,6 +526,15 @@ TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
}
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;
}
@@ -635,8 +655,9 @@ TkGetBitmapData(interp, string, fileName, widthPtr, heightPtr,
error:
if (interp != NULL) {
- interp->result = "format error in bitmap data";
+ Tcl_SetResult(interp, "format error in bitmap data", TCL_STATIC);
}
+
errorCleanup:
if (data != NULL) {
ckfree(data);
@@ -735,52 +756,52 @@ NextBitmapWord(parseInfoPtr)
*/
static int
-ImgBmapCmd(clientData, interp, argc, argv)
+ImgBmapCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about the image master. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ static char *bmapOptions[] = {"cget", "configure", (char *) NULL};
BitmapMaster *masterPtr = (BitmapMaster *) clientData;
- int c, code;
- size_t length;
+ int code, index;
- if (argc < 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s option ?arg arg ...?\"",
- argv[0]);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
+ 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, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
+ (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 (argc == 3) {
+ } else if (objc == 3) {
code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
- configSpecs, (char *) masterPtr, argv[2], 0);
+ configSpecs, (char *) masterPtr,
+ Tcl_GetString(objv[2]), 0);
} else {
- code = ImgBmapConfigureMaster(masterPtr, argc-2, argv+2,
+ code = ImgBmapConfigureMaster(masterPtr, objc-2, objv+2,
TK_CONFIG_ARGV_ONLY);
}
return code;
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be cget or configure", (char *) NULL);
- return TCL_ERROR;
+ }
+ default: {
+ panic("bad const entries to bmapOptions in ImgBmapCmd");
+ }
}
+ return TCL_OK;
}
/*
@@ -1080,3 +1101,104 @@ GetByte(chan)
return buffer;
}
}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapPostscript --
+ *
+ * This procedure is called by the image code to create
+ * postscript output for an image.
+ *
+ * Results:
+ * None.
+ *
+ * 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;
+ int rowsAtOnce, rowsThisTime;
+ int curRow, yy;
+ char buffer[200];
+
+ if (prepass) {
+ return TCL_OK;
+ }
+ /*
+ * Color the background, if there is one.
+ */
+
+ if (masterPtr->bgUid != NULL) {
+ XColor color;
+ XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid,
+ &color);
+ sprintf(buffer,
+ "%d %d 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_PostscriptColor(interp, psinfo, &color) != 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 (masterPtr->fgUid != 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 (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, "%d %d translate\n", x, y);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (curRow = y+height-1; curRow >= y; curRow -= rowsAtOnce) {
+ rowsThisTime = rowsAtOnce;
+ if (rowsThisTime > (curRow + 1 - y)) {
+ rowsThisTime = curRow + 1 - y;
+ }
+ sprintf(buffer, "%d %d", width, rowsThisTime);
+ Tcl_AppendResult(interp, buffer, " true matrix {\n<",
+ (char *) NULL);
+ for (yy = curRow; yy >= (curRow - rowsThisTime + 1); yy--) {
+ sprintf(buffer, "row %d\n", yy);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+ sprintf(buffer, "0 %.15g", (double) rowsThisTime);
+ Tcl_AppendResult(interp, ">\n} imagemask\n", buffer,
+ " translate\n", (char *) NULL);
+ }
+ }
+ return TCL_OK;
+}
+
diff --git a/tk/generic/tkImgGIF.c b/tk/generic/tkImgGIF.c
index 98bb23af4e4..f9588892b4a 100644
--- a/tk/generic/tkImgGIF.c
+++ b/tk/generic/tkImgGIF.c
@@ -2,8 +2,8 @@
* tkImgGIF.c --
*
* A photo image file handler for GIF files. Reads 87a and 89a GIF
- * files. At present there is no write function. GIF images may be
- * read using the -data option of the photo image. The data may be
+ * 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
@@ -63,29 +63,67 @@ typedef struct mFile {
#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[] =
+ { 0x47, 0x49, 0x46, 0x38, 0x37, 0x61, 0x00 }; /* ASCII GIF87a */
+static CONST char GIF89a[] =
+ { 0x47, 0x49, 0x46, 0x38, 0x39, 0x61, 0x00 }; /* ASCII GIF89a */
+# 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, char *fileName,
- char *formatString, int *widthPtr, int *heightPtr));
+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, char *fileName, char *formatString,
+ 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,
- char *formatString, int *widthPtr, int *heightPtr));
+ Tcl_Obj *format, int *widthPtr, int *heightPtr,
+ Tcl_Interp *interp));
static int StringReadGIF _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *dataObj,
- char *formatString, Tk_PhotoHandle imageHandle,
+ 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 */
+ "gif", /* name */
FileMatchGIF, /* fileMatchProc */
StringMatchGIF, /* stringMatchProc */
FileReadGIF, /* fileReadProc */
StringReadGIF, /* stringReadProc */
- NULL, /* fileWriteProc */
+ FileWriteGIF, /* fileWriteProc */
NULL, /* stringWriteProc */
};
@@ -102,15 +140,6 @@ Tk_PhotoImageFormat tkImgFmtGIF = {
#define ReadOK(file,buffer,len) (Fread(buffer, len, 1, file) != 0)
/*
- * HACK ALERT!! HACK ALERT!! HACK ALERT!!
- * This code is hard-wired for reading from files. In order to read
- * from a data stream, we'll trick fread so we can reuse the same code.
- * 0==from file; 1==from base64 encoded data; 2==from binary data
- */
-
-static int fromData=0;
-
-/*
* Prototypes for local procedures defined in this file:
*/
@@ -120,8 +149,6 @@ static int GetCode _ANSI_ARGS_((Tcl_Channel chan, int code_size,
int flag));
static int GetDataBlock _ANSI_ARGS_((Tcl_Channel chan,
unsigned char *buf));
-static int LWZReadByte _ANSI_ARGS_((Tcl_Channel chan, int flag,
- int input_code_size));
static int ReadColorMap _ANSI_ARGS_((Tcl_Channel chan, int number,
unsigned char buffer[MAXCOLORMAPSIZE][4]));
static int ReadGIFHeader _ANSI_ARGS_((Tcl_Channel chan,
@@ -145,6 +172,7 @@ static int Mgetc _ANSI_ARGS_((MFile *handle));
static int char64 _ANSI_ARGS_((int c));
static void mInit _ANSI_ARGS_((unsigned char *string,
MFile *handle));
+
/*
*----------------------------------------------------------------------
@@ -165,13 +193,14 @@ static void mInit _ANSI_ARGS_((unsigned char *string,
*/
static int
-FileMatchGIF(chan, fileName, formatString, widthPtr, heightPtr)
+FileMatchGIF(chan, fileName, format, widthPtr, heightPtr, interp)
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. */
+ 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);
}
@@ -197,12 +226,12 @@ FileMatchGIF(chan, fileName, formatString, widthPtr, heightPtr)
*/
static int
-FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
+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. */
- char *fileName; /* The name of the image file. */
- char *formatString; /* User-specified format string, or NULL. */
+ 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. */
@@ -212,15 +241,39 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
* in image being read. */
{
int fileWidth, fileHeight;
- int nBytes;
+ 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 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 \"",
+ Tcl_AppendResult(interp, "couldn't read GIF header from file \"",
fileName, "\"", NULL);
return TCL_ERROR;
}
@@ -263,8 +316,8 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
block.offset[0] = 0;
block.offset[1] = 1;
block.offset[2] = 2;
- nBytes = height * block.pitch;
- block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+ block.offset[3] = 3;
+ block.pixelPtr = NULL;
while (1) {
if (Fread(buf, 1, 1, chan) != 1) {
@@ -276,15 +329,17 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
break;
}
- if (buf[0] == ';') {
+ if (buf[0] == GIF_TERMINATOR) {
/*
* GIF terminator.
*/
- break;
+ Tcl_AppendResult(interp,"no image data for this index",
+ (char *) NULL);
+ goto error;
}
- if (buf[0] == '!') {
+ if (buf[0] == GIF_EXTENSION) {
/*
* This is a GIF extension.
*/
@@ -301,7 +356,7 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
continue;
}
- if (buf[0] != ',') {
+ if (buf[0] != GIF_START) {
/*
* Not a valid start character; ignore it.
*/
@@ -313,8 +368,55 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
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",
@@ -322,50 +424,62 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
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 * width;
+ nBytes = block.pitch * height;
+ block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+
if (ReadImage(interp, (char *) block.pixelPtr, chan, width,
height, colorMap, fileWidth, fileHeight, srcX, srcY,
BitSet(buf[8], INTERLACE), transparent) != TCL_OK) {
goto error;
}
break;
- }
+ }
- if (transparent == -1) {
- Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height);
- } else {
- int x, y, end;
- unsigned char *imagePtr, *rowPtr, *pixelPtr;
-
- imagePtr = rowPtr = block.pixelPtr;
- for (y = 0; y < height; y++) {
- x = 0;
- pixelPtr = rowPtr;
- while(x < width) {
- /* search for first non-transparent pixel */
- while ((x < width) && !(pixelPtr[CM_ALPHA])) {
- x++; pixelPtr += 4;
- }
- end = x;
- /* search for first transparent pixel */
- while ((end < width) && pixelPtr[CM_ALPHA]) {
- end++; pixelPtr += 4;
- }
- if (end > x) {
- block.pixelPtr = rowPtr + 4 * x;
- Tk_PhotoPutBlock(imageHandle, &block, destX+x,
- destY+y, end-x, 1);
- }
- x = end;
- }
- rowPtr += block.pitch;
- }
- block.pixelPtr = imagePtr;
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height);
+
+ noerror:
+ if (block.pixelPtr) {
+ ckfree((char *) block.pixelPtr);
}
- ckfree((char *) block.pixelPtr);
+ Tcl_AppendResult(interp, tkImgFmtGIF.name, (char *) NULL);
return TCL_OK;
error:
- ckfree((char *) block.pixelPtr);
+ if (block.pixelPtr) {
+ ckfree((char *) block.pixelPtr);
+ }
return TCL_ERROR;
}
@@ -389,17 +503,18 @@ FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
*/
static int
-StringMatchGIF(dataObj, formatString, widthPtr, heightPtr)
+StringMatchGIF(dataObj, format, widthPtr, heightPtr, interp)
Tcl_Obj *dataObj; /* the object containing the image data */
- char *formatString; /* the image format string */
+ 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_GetStringFromObj(dataObj, &length);
+ data = Tcl_GetByteArrayFromObj(dataObj, &length);
/* Header is a minimum of 10 bytes */
if (length < 10) {
@@ -408,14 +523,14 @@ StringMatchGIF(dataObj, formatString, widthPtr, heightPtr)
/* Check whether the data is Base64 encoded */
- if ((strncmp("GIF87a", data, 6) != 0) &&
- (strncmp("GIF89a", data, 6) != 0)) {
+ 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))) {
+ || ((strncmp(GIF87a, (char *) header, 6) != 0)
+ && (strncmp(GIF89a, (char *) header, 6) != 0))) {
return 0;
}
} else {
@@ -448,37 +563,41 @@ StringMatchGIF(dataObj, formatString, widthPtr, heightPtr)
*/
static int
-StringReadGIF(interp,dataObj,formatString,imageHandle,
+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 */
- char *formatString; /* format string if any */
+ 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;
- Tcl_Channel dataSrc;
- char *data;
- /* Check whether the data is Base64 encoded */
- data = Tcl_GetStringFromObj(dataObj, NULL);
- if ((strncmp("GIF87a", data, 6) != 0) &&
- (strncmp("GIF89a", data, 6) != 0)) {
- mInit((unsigned char *)data,&handle);
- fromData = 1;
- dataSrc = (Tcl_Channel) &handle;
- } else {
- fromData = 2;
- mInit((unsigned char *)data,&handle);
- dataSrc = (Tcl_Channel) &handle;
- }
- result = FileReadGIF(interp, dataSrc, "inline data",
- formatString, imageHandle, destX, destY, width, height,
- srcX, srcY);
- fromData = 0;
- return(result);
+ 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);
}
/*
@@ -510,8 +629,8 @@ ReadGIFHeader(chan, widthPtr, heightPtr)
unsigned char buf[7];
if ((Fread(buf, 1, 6, chan) != 6)
- || ((strncmp("GIF87a", (char *) buf, 6) != 0)
- && (strncmp("GIF89a", (char *) buf, 6) != 0))) {
+ || ((strncmp(GIF87a, (char *) buf, 6) != 0)
+ && (strncmp(GIF89a, (char *) buf, 6) != 0))) {
return 0;
}
@@ -545,10 +664,12 @@ ReadColorMap(chan, number, buffer)
return 0;
}
- buffer[i][CM_RED] = rgb[0] ;
- buffer[i][CM_GREEN] = rgb[1] ;
- buffer[i][CM_BLUE] = rgb[2] ;
- buffer[i][CM_ALPHA] = 255 ;
+ 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;
}
@@ -621,6 +742,34 @@ GetDataBlock(chan, buf)
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
@@ -634,26 +783,27 @@ ReadImage(interp, imagePtr, chan, len, rows, cmap,
int interlace;
int transparent;
{
- unsigned char c;
+ unsigned char initialCodeSize;
int v;
- int xpos = 0, ypos = 0, pass = 0;
- char *pixelPtr;
-
-
+ 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,
+ code, firstCode;
+
/*
- * Initialize the Compression routines
+ * Initialize the decoder
*/
- if (! ReadOK(chan, &c, 1)) {
+ if (! ReadOK(chan, &initialCodeSize, 1)) {
Tcl_AppendResult(interp, "error reading GIF image: ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
-
- if (LWZReadByte(chan, 1, c) < 0) {
- interp->result = "format error in GIF image";
- return TCL_ERROR;
- }
-
if (transparent!=-1) {
cmap[transparent][CM_RED] = 0;
cmap[transparent][CM_GREEN] = 0;
@@ -662,180 +812,194 @@ ReadImage(interp, imagePtr, chan, len, rows, cmap,
}
pixelPtr = imagePtr;
- while ((v = LWZReadByte(chan, 0, c)) >= 0 ) {
- if ((xpos>=srcX) && (xpos<srcX+len) &&
- (ypos>=srcY) && (ypos<srcY+rows)) {
- *pixelPtr++ = cmap[v][CM_RED];
- *pixelPtr++ = cmap[v][CM_GREEN];
- *pixelPtr++ = cmap[v][CM_BLUE];
- *pixelPtr++ = cmap[v][CM_ALPHA];
- }
-
- ++xpos;
- if (xpos == width) {
- xpos = 0;
- if (interlace) {
- switch (pass) {
- case 0:
- case 1:
- ypos += 8; break;
- case 2:
- ypos += 4; break;
- case 3:
- ypos += 2; break;
- }
-
- while (ypos >= height) {
- ++pass;
- switch (pass) {
- case 1:
- ypos = 4; break;
- case 2:
- ypos = 2; break;
- case 3:
- ypos = 1; break;
- default:
- return TCL_OK;
- }
- }
- } else {
- ++ypos;
- }
- pixelPtr = imagePtr + (ypos-srcY) * len * 4;
- }
- if (ypos >= height)
- break;
+ /* 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;
}
- return TCL_OK;
-}
-
-static int
-LWZReadByte(chan, flag, input_code_size)
- Tcl_Channel chan;
- int flag;
- int input_code_size;
-{
- static int fresh = 0;
- int code, incode;
- static int code_size, set_code_size;
- static int max_code, max_code_size;
- static int firstcode, oldcode;
- static int clear_code, end_code;
- static int table[2][(1<< MAX_LWZ_BITS)];
- static int stack[(1<<(MAX_LWZ_BITS))*2], *sp;
- register int i;
-
- if (flag) {
- set_code_size = input_code_size;
- code_size = set_code_size+1;
- clear_code = 1 << set_code_size ;
- end_code = clear_code + 1;
- max_code_size = 2*clear_code;
- max_code = clear_code+2;
+ top = stack;
- GetCode(chan, 0, 1);
+ GetCode(chan, 0, 1);
- fresh = 1;
+ /* Read until we finish the image */
+ for (i = 0, ypos = 0; i < rows; i++) {
+ for (xpos = 0; xpos < len; ) {
- for (i = 0; i < clear_code; ++i) {
- table[0][i] = 0;
- table[1][i] = i;
- }
- for (; i < (1<<MAX_LWZ_BITS); ++i) {
- table[0][i] = table[1][0] = 0;
- }
+ if (top == stack) {
+ /* Bummer -- our stack is empty. Now we have to work! */
+ code = GetCode(chan, codeSize, 0);
+ if (code < 0) {
+ return TCL_OK;
+ }
- sp = stack;
+ 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;
+ }
- return 0;
- } else if (fresh) {
- fresh = 0;
- do {
- firstcode = oldcode = GetCode(chan, code_size, 0);
- } while (firstcode == clear_code);
- return firstcode;
- }
+ 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;
+ }
- if (sp > stack) {
- return *--sp;
- }
+ 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];
- while ((code = GetCode(chan, code_size, 0)) >= 0) {
- if (code == clear_code) {
- for (i = 0; i < clear_code; ++i) {
- table[0][i] = 0;
- table[1][i] = i;
- }
-
- for (; i < (1<<MAX_LWZ_BITS); ++i) {
- table[0][i] = table[1][i] = 0;
- }
+ /*
+ * 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;
+ }
- code_size = set_code_size+1;
- max_code_size = 2*clear_code;
- max_code = clear_code+2;
- sp = stack;
- firstcode = oldcode = GetCode(chan, code_size, 0);
- return firstcode;
+ /* Push the head of the string onto the stack */
+ *top++ = firstCode;
- } else if (code == end_code) {
- int count;
- unsigned char buf[260];
+ /* Add a new string to the string table */
+ prefix[maxCode] = oldCode;
+ append[maxCode] = firstCode;
+ maxCode++;
- if (ZeroDataBlock) {
- return -2;
+ /* 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;
}
-
- while ((count = GetDataBlock(chan, buf)) > 0)
- /* Empty body */;
- if (count != 0) {
- return -2;
+ /* Pop the next color index off the stack */
+ v = *(--top);
+ if (v < 0) {
+ return TCL_OK;
}
- }
-
- incode = code;
-
- if (code >= max_code) {
- *sp++ = firstcode;
- code = oldcode;
- }
- while (code >= clear_code) {
- *sp++ = table[1][code];
- if (code == table[0][code]) {
- return -2;
-
- /*
- * Used to be this instead, Steve Ball suggested
- * the change to just return.
- printf("circular table entry BIG ERROR\n");
- */
+ /*
+ * 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];
}
- code = table[0][code];
- }
-
- *sp++ = firstcode = table[1][code];
+ xpos++;
- if ((code = max_code) <(1<<MAX_LWZ_BITS)) {
- table[0][code] = oldcode;
- table[1][code] = firstcode;
- ++max_code;
- if ((max_code>=max_code_size) && (max_code_size < (1<<MAX_LWZ_BITS))) {
- max_code_size *= 2;
- ++code_size;
- }
}
- oldcode = incode;
-
- if (sp > stack)
- return *--sp;
+ /* 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++;
}
- return code;
+ 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)
@@ -844,46 +1008,50 @@ GetCode(chan, code_size, flag)
int flag;
{
static unsigned char buf[280];
- static int curbit, lastbit, done, last_byte;
- int i, j, ret;
- unsigned char count;
+ static int bytes = 0, done;
+ static unsigned char *c;
+ static unsigned int window;
+ static int bitsInWindow = 0;
+ int ret;
+
if (flag) {
- curbit = 0;
- lastbit = 0;
+ /* Initialize the decoder */
+ bitsInWindow = 0;
+ bytes = 0;
+ window = 0;
done = 0;
+ c = NULL;
return 0;
}
-
- if ( (curbit+code_size) >= lastbit) {
+ while (bitsInWindow < code_size) {
+ /* Not enough bits in our window to cover the request */
if (done) {
- /* ran off the end of my bits */
return -1;
}
- if (last_byte >= 2) {
- buf[0] = buf[last_byte-2];
- }
- if (last_byte >= 1) {
- buf[1] = buf[last_byte-1];
- }
-
- if ((count = GetDataBlock(chan, &buf[2])) == 0) {
- done = 1;
+ 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;
+ }
}
-
- last_byte = 2 + count;
- curbit = (curbit - lastbit) + 16;
- lastbit = (2+count)*8 ;
+ /* Tack another byte onto the window, see if that's enough */
+ window += (*c) << bitsInWindow;
+ c++;
+ bitsInWindow += 8;
+ bytes--;
}
- ret = 0;
- for (i = curbit, j = 0; j < code_size; ++i, ++j) {
- ret |= ((buf[ i / 8 ] & (1 << (i % 8))) != 0) << j;
- }
-
- curbit += code_size;
-
+ /* 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;
}
@@ -1083,16 +1251,761 @@ Fread(dst, hunk, count, chan)
size_t hunk,count; /* how many */
Tcl_Channel chan;
{
- MFile *handle;
- switch (fromData) {
- case 0:
- return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
+ 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, (int) (hunk * count));
+ 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) {
+ 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;
+ for (x=(alphaOffset != 0);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 DEBUGGING_ENVARS */
+
+#ifdef DEBUGGING_ENVARS
+
+static int verbose_set = 0;
+static int verbose;
+#define VERBOSE (verbose_set?verbose:set_verbose())
+
+static int set_verbose(void)
+{
+ verbose = !!getenv("GIF_VERBOSE");
+ verbose_set = 1;
+ return(verbose);
+}
+
+#else
+
+#define VERBOSE 0
+
+#endif
+
+
+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]);
+}
+
+static void write_block()
+{
+ int i;
+ unsigned char c;
+
+ if (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;
+{
+ if (VERBOSE) printf("block_out %s\n",binformat(c,8));
+ oblock[oblen++] = c;
+ if (oblen >= 255) write_block();
+}
+
+static void block_flush()
+{
+ if (VERBOSE) printf("block_flush\n");
+ if (oblen > 0) write_block();
+}
+
+static void output(val)
+ int val;
+{
+ if (VERBOSE) printf("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;
+ }
+ if (VERBOSE) printf("output leaving [%s %d]\n",binformat(obuf,obits),obits);
+}
+
+static void output_flush()
+{
+ if (VERBOSE) printf("output_flush\n");
+ if (obits > 0) block_out(obuf);
+ block_flush();
+}
+
+static void did_clear()
+{
+ if (VERBOSE) printf("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;
+{
+ if (VERBOSE) printf("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;
+
+ if (VERBOSE) printf("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();
+ if (VERBOSE) printf("rl_flush_fromclear leaving table_max=%d\n",rl_table_max);
+}
+
+static void rl_flush_clearorrep(count)
+ int count;
+{
+ int withclr;
+
+ if (VERBOSE) printf("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;
+
+ if (VERBOSE) printf("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);
+ }
+ if (VERBOSE) printf("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()
+{
+ if (VERBOSE) printf("rl_flush [ %d %d\n",rl_count,rl_pixel);
+ if (rl_count == 1)
+ { output_plain(rl_pixel);
+ rl_count = 0;
+ if (VERBOSE) printf("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);
+ }
+ if (VERBOSE) printf("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 DEBUGGING_ENVARS
+ { const char *ocienv;
+ ocienv = getenv("GIF_OUT_CLEAR_INIT");
+ if (ocienv)
+ { out_clear_init = atoi(ocienv);
+ if (VERBOSE) printf("[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/tk/generic/tkImgPPM.c b/tk/generic/tkImgPPM.c
index 02309eb6588..8e5d17aee2b 100644
--- a/tk/generic/tkImgPPM.c
+++ b/tk/generic/tkImgPPM.c
@@ -16,6 +16,8 @@
* RCS: @(#) $Id$
*/
+#define USE_OLD_IMAGE
+
#include "tkInt.h"
#include "tkPort.h"
@@ -110,7 +112,7 @@ FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr)
*
* Results:
* A standard TCL completion code. If TCL_ERROR is returned
- * then an error message is left in interp->result.
+ * 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
@@ -151,7 +153,7 @@ FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
return TCL_ERROR;
}
if ((maxIntensity <= 0) || (maxIntensity >= 256)) {
- char buffer[30];
+ char buffer[TCL_INTEGER_SPACE];
sprintf(buffer, "%d", maxIntensity);
Tcl_AppendResult(interp, "PPM image file \"", fileName,
@@ -183,6 +185,7 @@ FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
block.offset[1] = 1;
block.offset[2] = 2;
}
+ block.offset[3] = 0;
block.width = width;
block.pitch = block.pixelSize * fileWidth;
@@ -243,7 +246,7 @@ FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
*
* Results:
* A standard TCL completion code. If TCL_ERROR is returned
- * then an error message is left in interp->result.
+ * then an error message is left in the interp's result.
*
* Side effects:
* Data is written to the file given by "fileName".
@@ -262,13 +265,22 @@ FileWritePPM(interp, fileName, formatString, blockPtr)
int w, h;
int greenOffset, blueOffset, nBytes;
unsigned char *pixelPtr, *pixLinePtr;
- char header[30];
+ 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) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
sprintf(header, "P6\n%d %d\n255\n", blockPtr->width, blockPtr->height);
Tcl_Write(chan, header, -1);
@@ -343,7 +355,7 @@ ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
{
#define BUFFER_SIZE 1000
char buffer[BUFFER_SIZE];
- int i, numFields, firstInLine;
+ int i, numFields;
int type = 0;
char c;
@@ -355,7 +367,6 @@ ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
if (Tcl_Read(chan, &c, 1) != 1) {
return 0;
}
- firstInLine = 1;
i = 0;
for (numFields = 0; numFields < 4; numFields++) {
/*
@@ -364,7 +375,6 @@ ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
while (1) {
while (isspace(UCHAR(c))) {
- firstInLine = (c == '\n');
if (Tcl_Read(chan, &c, 1) != 1) {
return 0;
}
@@ -377,7 +387,6 @@ ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
return 0;
}
} while (c != '\n');
- firstInLine = 1;
}
/*
@@ -397,7 +406,6 @@ ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
buffer[i] = ' ';
i++;
}
- firstInLine = 0;
}
done:
buffer[i] = 0;
@@ -419,3 +427,4 @@ ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
}
return type;
}
+
diff --git a/tk/generic/tkImgPhoto.c b/tk/generic/tkImgPhoto.c
index 72fddfe1478..7416771041b 100644
--- a/tk/generic/tkImgPhoto.c
+++ b/tk/generic/tkImgPhoto.c
@@ -2,7 +2,7 @@
* tkImgPhoto.c --
*
* Implements images of type "photo" for Tk. Photo images are
- * stored in full color (24 bits per pixel) and displayed using
+ * stored in full color (32 bits per pixel) and displayed using
* dithering if necessary.
*
* Copyright (c) 1994 The Australian National University.
@@ -11,6 +11,10 @@
* 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$
*/
@@ -19,11 +23,15 @@
#include "tclMath.h"
#include <ctype.h>
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
/*
* Declaration for internal Xlib function used here:
*/
-extern _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));
+extern int _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));
/*
* A signed 8-bit integral type. If chars are unsigned and the compiler
@@ -121,6 +129,9 @@ typedef struct ColorTable {
* 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
@@ -147,8 +158,8 @@ typedef struct PhotoMaster {
* instances of this image. */
double gamma; /* Display gamma value to correct for. */
char *fileString; /* Name of file to read into image. */
- Tcl_Obj *dataObj; /* Object to use as contents of image. */
- char *format; /* User-specified format of data in image
+ 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
@@ -211,14 +222,14 @@ typedef struct PhotoInstance {
struct SubcommandOptions {
int options; /* Individual bits indicate which
* options were specified - see below. */
- char *name; /* Name specified without an option. */
+ 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. */
- char *format; /* Value specified for -format option. */
+ Tcl_Obj *format; /* Value specified for -format option. */
XColor *background; /* Value specified for -background option. */
};
@@ -270,7 +281,7 @@ static char *optionNames[] = {
*/
static int ImgPhotoCreate _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, int argc, Tcl_Obj *CONST objv[],
+ char *name, int objc, Tcl_Obj *CONST objv[],
Tk_ImageType *typePtr, Tk_ImageMaster master,
ClientData *clientDataPtr));
static ClientData ImgPhotoGet _ANSI_ARGS_((Tk_Window tkwin,
@@ -282,6 +293,10 @@ static void ImgPhotoDisplay _ANSI_ARGS_((ClientData clientData,
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));
Tk_ImageType tkPhotoImageType = {
"photo", /* name */
@@ -290,9 +305,18 @@ Tk_ImageType tkPhotoImageType = {
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.*/
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
/*
* Default configuration
*/
@@ -306,8 +330,6 @@ Tk_ImageType tkPhotoImageType = {
* Information used for parsing configuration specifications:
*/
static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_STRING, "-format", (char *) NULL, (char *) NULL,
- (char *) NULL, Tk_Offset(PhotoMaster, format), TK_CONFIG_NULL_OK},
{TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
(char *) NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK},
{TK_CONFIG_DOUBLE, "-gamma", (char *) NULL, (char *) NULL,
@@ -332,26 +354,20 @@ static int imgPhotoColorHashInitialized;
#define N_COLOR_HASH (sizeof(ColorTableId) / sizeof(int))
/*
- * Pointer to the first in the list of known photo image formats.
- */
-
-static Tk_PhotoImageFormat *formatList = NULL;
-
-/*
* Forward declarations
*/
static int ImgPhotoCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
+ 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 argc, char **argv));
+ 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 argc, Tcl_Obj *CONST objv[], int flags));
+ int objc, Tcl_Obj *CONST objv[], int flags));
static void ImgPhotoConfigureInstance _ANSI_ARGS_((
PhotoInstance *instancePtr));
static void ImgPhotoSetSize _ANSI_ARGS_((PhotoMaster *masterPtr,
@@ -359,7 +375,7 @@ static void ImgPhotoSetSize _ANSI_ARGS_((PhotoMaster *masterPtr,
static void ImgPhotoInstanceSetSize _ANSI_ARGS_((
PhotoInstance *instancePtr));
static int ImgStringWrite _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_DString *dataPtr, char *formatString,
+ Tcl_Obj *formatString,
Tk_PhotoImageBlock *blockPtr));
static char * ImgGetPhoto _ANSI_ARGS_((PhotoMaster *masterPtr,
Tk_PhotoImageBlock *blockPtr,
@@ -376,18 +392,19 @@ static void DisposeInstance _ANSI_ARGS_((ClientData clientData));
static int ReclaimColors _ANSI_ARGS_((ColorTableId *id,
int numColors));
static int MatchFileFormat _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Channel chan, char *fileName,
- char *formatString,
+ Tcl_Channel chan, char *fileName, Tcl_Obj *formatString,
Tk_PhotoImageFormat **imageFormatPtr,
- int *widthPtr, int *heightPtr));
+ int *widthPtr, int *heightPtr, int *oldformat));
static int MatchStringFormat _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *dataObj, char *formatString,
+ Tcl_Obj *data, Tcl_Obj *formatString,
Tk_PhotoImageFormat **imageFormatPtr,
- int *widthPtr, int *heightPtr));
-static void Dither _ANSI_ARGS_((PhotoMaster *masterPtr,
- int x, int y, int width, int height));
+ 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))
@@ -397,7 +414,7 @@ static void DitherInstance _ANSI_ARGS_((PhotoInstance *instancePtr,
/*
*----------------------------------------------------------------------
*
- * Tk_CreatePhotoImageFormat --
+ * 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
@@ -413,6 +430,25 @@ static void DitherInstance _ANSI_ARGS_((PhotoInstance *instancePtr,
*
*----------------------------------------------------------------------
*/
+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));
+
+ 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)
@@ -423,13 +459,20 @@ Tk_CreatePhotoImageFormat(formatPtr)
* to Tk_CreatePhotoImageFormat previously. */
{
Tk_PhotoImageFormat *copyPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
copyPtr = (Tk_PhotoImageFormat *) ckalloc(sizeof(Tk_PhotoImageFormat));
*copyPtr = *formatPtr;
copyPtr->name = (char *) ckalloc((unsigned) (strlen(formatPtr->name) + 1));
strcpy(copyPtr->name, formatPtr->name);
- copyPtr->nextPtr = formatList;
- formatList = copyPtr;
+ if (isupper((unsigned char) *formatPtr->name)) {
+ copyPtr->nextPtr = tsdPtr->oldFormatList;
+ tsdPtr->oldFormatList = copyPtr;
+ } else {
+ copyPtr->nextPtr = tsdPtr->formatList;
+ tsdPtr->formatList = copyPtr;
+ }
}
/*
@@ -451,11 +494,11 @@ Tk_CreatePhotoImageFormat(formatPtr)
*/
static int
-ImgPhotoCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
+ImgPhotoCreate(interp, name, objc, objv, typePtr, master, clientDataPtr)
Tcl_Interp *interp; /* Interpreter for application containing
* image. */
char *name; /* Name to use for image. */
- int argc; /* Number of arguments. */
+ 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). */
@@ -485,7 +528,7 @@ ImgPhotoCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
* Process configuration options given in the image create command.
*/
- if (ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, 0) != TCL_OK) {
+ if (ImgPhotoConfigureMaster(interp, masterPtr, objc, objv, 0) != TCL_OK) {
ImgPhotoDelete((ClientData) masterPtr);
return TCL_ERROR;
}
@@ -513,14 +556,24 @@ ImgPhotoCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
*/
static int
-ImgPhotoCmd(clientData, interp, argc, objv)
+ImgPhotoCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about photo master. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
+ int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
+ int oldformat = 0;
+ static char *photoOptions[] = {
+ "blank", "cget", "configure", "copy", "data", "get", "put",
+ "read", "redither", "write", (char *) NULL
+ };
+ enum options {
+ PHOTO_BLANK, PHOTO_CGET, PHOTO_CONFIGURE, PHOTO_COPY, PHOTO_DATA,
+ PHOTO_GET, PHOTO_PUT, PHOTO_READ, PHOTO_REDITHER, PHOTO_WRITE
+ };
+
PhotoMaster *masterPtr = (PhotoMaster *) clientData;
- int c, result, index;
+ int result, index;
int x, y, width, height;
int dataWidth, dataHeight;
struct SubcommandOptions options;
@@ -530,7 +583,6 @@ ImgPhotoCmd(clientData, interp, argc, objv)
unsigned char *pixelPtr;
Tk_PhotoImageBlock block;
Tk_Window tkwin;
- char string[16];
XColor color;
Tk_PhotoImageFormat *imageFormat;
int imageWidth, imageHeight;
@@ -538,96 +590,126 @@ ImgPhotoCmd(clientData, interp, argc, objv)
Tcl_Channel chan;
Tk_PhotoHandle srcHandle;
size_t length;
- static char **argv = NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?arg arg ...?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- if (argv) {
- ckfree((char *) argv);
- }
- argv = (char **) ckalloc((argc+1) * sizeof(char *));
- argv[argc] = NULL;
- for (index = 0; index < argc; index++) {
- argv[index] = Tcl_GetStringFromObj(objv[index], (int *) NULL);
+ 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);
}
- c = argv[1][0];
- length = strlen(argv[1]);
-
- if ((c == 'b') && (strncmp(argv[1], "blank", length) == 0)) {
+ switch ((enum options) index) {
+ case PHOTO_BLANK: {
/*
* photo blank command - just call Tk_PhotoBlank.
*/
- if (argc == 2) {
+ if (objc == 2) {
Tk_PhotoBlank(masterPtr);
} else {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " blank\"", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
return TCL_ERROR;
}
- } else if ((c == 'c') && (length >= 2)
- && (strncmp(argv[1], "cget", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
+ break;
+ }
+ case PHOTO_CGET: {
+ char *arg;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
return TCL_ERROR;
}
- if (strncmp(argv[2],"-data", length) == 0) {
- if (masterPtr->dataObj) {
- Tcl_SetObjResult(interp, masterPtr->dataObj);
+ 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, argv[2], 0);
- } else if ((c == 'c') && (length >= 3)
- && (strncmp(argv[1], "configure", length) == 0)) {
+ (char *) masterPtr, Tcl_GetString(objv[2]), 0);
+ break;
+ }
+ case PHOTO_CONFIGURE: {
/*
* photo configure command - handle this in the standard way.
*/
char *opt, *arg;
- if (argc == 2) {
+ 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;
}
- opt = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
- arg = (char *) ckalloc(length + 1);
- strcpy(arg, opt);
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "{-data {} {} {} {}} ", arg, (char*) NULL);
- ckfree(arg);
+ 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 (argc == 3) {
- if (strncmp(argv[2], "-data", length)) {
- return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
- configSpecs, (char *) masterPtr, argv[2], 0);
- } else {
+ 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),
- "-data {} {} {} ", (char *) NULL);
- if (masterPtr->dataObj) {
+ "-format {} {} {}", (char *) NULL);
+ if (masterPtr->format) {
Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
- masterPtr->dataObj);
+ masterPtr->format);
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "{}", (char *) NULL);
+ " {}", (char *) NULL);
}
return TCL_OK;
+ } else {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, arg, 0);
}
}
- return ImgPhotoConfigureMaster(interp, masterPtr, argc-2, objv+2,
+ return ImgPhotoConfigureMaster(interp, masterPtr, objc-2, objv+2,
TK_CONFIG_ARGV_ONLY);
- } else if ((c == 'c') && (length >= 3)
- && (strncmp(argv[1], "copy", length) == 0)) {
+ break;
+ }
+ case PHOTO_COPY: {
/*
* photo copy command - first parse options.
*/
@@ -639,14 +721,12 @@ ImgPhotoCmd(clientData, interp, argc, objv)
options.name = NULL;
if (ParseSubcommandOptions(&options, interp,
OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK,
- &index, argc, argv) != TCL_OK) {
+ &index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if (options.name == NULL || index < argc) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " copy source-image ?-from x1 y1 x2 y2?",
- " ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?",
- "\"", (char *) NULL);
+ if (options.name == NULL || index < objc) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "source-image ?-from x1 y1 x2 y2? ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?");
return TCL_ERROR;
}
@@ -655,8 +735,9 @@ ImgPhotoCmd(clientData, interp, argc, objv)
* Check the values given for the -from option.
*/
- if ((srcHandle = Tk_FindPhoto(interp, options.name)) == NULL) {
- Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't",
+ if ((srcHandle = Tk_FindPhoto(interp, Tcl_GetString(options.name))) == NULL) {
+ Tcl_AppendResult(interp, "image \"",
+ Tcl_GetString(options.name), "\" doesn't",
" exist or is not a photo image", (char *) NULL);
return TCL_ERROR;
}
@@ -722,8 +803,9 @@ ImgPhotoCmd(clientData, interp, argc, objv)
options.toY2 - options.toY, options.zoomX, options.zoomY,
options.subsampleX, options.subsampleY);
- } else if ((c == 'd') && (strncmp(argv[1], "data", length) == 0)) {
- Tcl_DString buffer;
+ break;
+ }
+ case PHOTO_DATA: {
char *data;
/*
@@ -739,13 +821,11 @@ ImgPhotoCmd(clientData, interp, argc, objv)
options.fromY = 0;
if (ParseSubcommandOptions(&options, interp,
OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
- &index, argc, argv) != TCL_OK) {
+ &index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if ((options.name != NULL) || (index < argc)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " data ?-format format-name?",
- "?-from x1 y1 x2 y2?\"", (char *) NULL);
+ if ((options.name != NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?options?");
return TCL_ERROR;
}
if ((options.fromX > masterPtr->width)
@@ -771,10 +851,10 @@ ImgPhotoCmd(clientData, interp, argc, objv)
*/
if (options.options & OPT_FORMAT) {
- for (imageFormat = formatList; imageFormat != NULL;
+ for (imageFormat = tsdPtr->formatList; imageFormat != NULL;
imageFormat = imageFormat->nextPtr) {
- if ((strncasecmp(options.format, imageFormat->name,
- strlen(imageFormat->name)) == 0)) {
+ if ((strncasecmp(Tcl_GetString(options.format),
+ imageFormat->name, strlen(imageFormat->name)) == 0)) {
if (imageFormat->stringWriteProc != NULL) {
stringWriteProc = imageFormat->stringWriteProc;
break;
@@ -782,7 +862,8 @@ ImgPhotoCmd(clientData, interp, argc, objv)
}
}
if (stringWriteProc == NULL) {
- Tcl_AppendResult(interp, "image string format \"", options.format,
+ Tcl_AppendResult(interp, "image string format \"",
+ Tcl_GetString(options.format),
"\" is not supported", (char *) NULL);
return TCL_ERROR;
}
@@ -796,39 +877,37 @@ ImgPhotoCmd(clientData, interp, argc, objv)
*/
data = ImgGetPhoto(masterPtr, &block, &options);
- Tcl_DStringInit(&buffer);
- result = stringWriteProc(interp, &buffer,
- options.format, &block);
+ 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);
}
- if (result == TCL_OK) {
- Tcl_DStringResult(interp, &buffer);
- } else {
- Tcl_DStringFree(&buffer);
- }
return result;
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ break;
+ }
+ case PHOTO_GET: {
/*
* photo get command - first parse and check parameters.
*/
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " get x y\"", (char *) NULL);
+ char string[TCL_INTEGER_SPACE * 3];
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "x y");
return TCL_ERROR;
}
- if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ 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, argv[0], " get: ",
+ Tcl_AppendResult(interp, Tcl_GetString(objv[0]), " get: ",
"coordinates out of range", (char *) NULL);
return TCL_ERROR;
}
@@ -841,7 +920,9 @@ ImgPhotoCmd(clientData, interp, argc, objv)
sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1],
pixelPtr[2]);
Tcl_AppendResult(interp, string, (char *) NULL);
- } else if ((c == 'p') && (strncmp(argv[1], "put", length) == 0)) {
+ break;
+ }
+ case PHOTO_PUT: {
/*
* photo put command - first parse the options and colors specified.
*/
@@ -850,19 +931,19 @@ ImgPhotoCmd(clientData, interp, argc, objv)
memset((VOID *) &options, 0, sizeof(options));
options.name = NULL;
if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT,
- &index, argc, argv) != TCL_OK) {
+ &index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if ((options.name == NULL) || (index < argc)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " put data ?-format format? ?-to x1 y1 x2 y2?\"",
- (char *) NULL);
+ 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) == TCL_OK) {
+ &imageHeight, &oldformat) == TCL_OK) {
+ Tcl_Obj *format;
+ Tcl_Obj *data;
if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
options.toX2 = options.toX + imageWidth;
options.toY2 = options.toY + imageHeight;
@@ -873,8 +954,16 @@ ImgPhotoCmd(clientData, interp, argc, objv)
if (imageHeight > options.toY2 - options.toY) {
imageHeight = options.toY2 - options.toY;
}
- if ((*imageFormat->stringReadProc)(interp, objv[2],
- options.format, (Tk_PhotoHandle) masterPtr,
+ 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,
0, 0, imageWidth, imageHeight, options.toX, options.toY)
!= TCL_OK) {
return TCL_ERROR;
@@ -886,7 +975,8 @@ ImgPhotoCmd(clientData, interp, argc, objv)
return TCL_ERROR;
}
Tcl_ResetResult(interp);
- if (Tcl_SplitList(interp, options.name, &dataHeight, &srcArgv)
+ if (Tcl_SplitList(interp, Tcl_GetString(options.name),
+ &dataHeight, &srcArgv)
!= TCL_OK) {
return TCL_ERROR;
}
@@ -955,30 +1045,31 @@ ImgPhotoCmd(clientData, interp, argc, objv)
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);
ckfree((char *) block.pixelPtr);
- } else if ((c == 'r') && (length >= 3)
- && (strncmp(argv[1], "read", length) == 0)) {
+ break;
+ }
+ case PHOTO_READ: {
/*
* photo read command - first parse the options specified.
*/
+ Tcl_Obj *format;
index = 2;
memset((VOID *) &options, 0, sizeof(options));
options.name = NULL;
options.format = NULL;
if (ParseSubcommandOptions(&options, interp,
OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK,
- &index, argc, argv) != TCL_OK) {
+ &index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if ((options.name == NULL) || (index < argc)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " read fileName ?-format format-name?",
- " ?-from x1 y1 x2 y2? ?-to x y? ?-shrink?\"",
- (char *) NULL);
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "fileName ?options?");
return TCL_ERROR;
}
@@ -996,7 +1087,8 @@ ImgPhotoCmd(clientData, interp, argc, objv)
* Open the image file and look for a handler for it.
*/
- chan = Tcl_OpenFileChannel(interp, options.name, "r", 0);
+ chan = Tcl_OpenFileChannel(interp,
+ Tcl_GetString(options.name), "r", 0);
if (chan == NULL) {
return TCL_ERROR;
}
@@ -1004,8 +1096,14 @@ ImgPhotoCmd(clientData, interp, argc, objv)
!= TCL_OK) {
return TCL_ERROR;
}
- if (MatchFileFormat(interp, chan, options.name, options.format,
- &imageFormat, &imageWidth, &imageHeight) != TCL_OK) {
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ 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;
}
@@ -1044,17 +1142,22 @@ ImgPhotoCmd(clientData, interp, argc, objv)
* into the image.
*/
- result = (*imageFormat->fileReadProc)(interp, chan, options.name,
- options.format, (Tk_PhotoHandle) masterPtr, options.toX,
+ 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;
- } else if ((c == 'r') && (length >= 3)
- && (strncmp(argv[1], "redither", length) == 0)) {
-
- if (argc == 2) {
+ break;
+ }
+ case PHOTO_REDITHER: {
+ if (objc == 2) {
/*
* Call Dither if any part of the image is not correctly
* dithered at present.
@@ -1063,11 +1166,11 @@ ImgPhotoCmd(clientData, interp, argc, objv)
x = masterPtr->ditherX;
y = masterPtr->ditherY;
if (masterPtr->ditherX != 0) {
- Dither(masterPtr, x, y, masterPtr->width - x, 1);
+ Tk_DitherPhoto((Tk_PhotoHandle) masterPtr, x, y, masterPtr->width - x, 1);
}
if (masterPtr->ditherY < masterPtr->height) {
x = 0;
- Dither(masterPtr, 0, masterPtr->ditherY, masterPtr->width,
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, 0, masterPtr->ditherY, masterPtr->width,
masterPtr->height - masterPtr->ditherY);
}
@@ -1082,12 +1185,15 @@ ImgPhotoCmd(clientData, interp, argc, objv)
}
} else {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " redither\"", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
return TCL_ERROR;
}
- } else if ((c == 'w') && (strncmp(argv[1], "write", length) == 0)) {
+ break;
+ }
+ case PHOTO_WRITE: {
char *data;
+ Tcl_Obj *format;
+
/*
* Prevent file system access in safe interpreters.
*/
@@ -1108,13 +1214,11 @@ ImgPhotoCmd(clientData, interp, argc, objv)
options.format = NULL;
if (ParseSubcommandOptions(&options, interp,
OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
- &index, argc, argv) != TCL_OK) {
+ &index, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if ((options.name == NULL) || (index < argc)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " write fileName ?-format format-name?",
- "?-from x1 y1 x2 y2?\"", (char *) NULL);
+ if ((options.name == NULL) || (index < objc)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?options?");
return TCL_ERROR;
}
if ((options.fromX > masterPtr->width)
@@ -1141,16 +1245,30 @@ ImgPhotoCmd(clientData, interp, argc, objv)
*/
matched = 0;
- for (imageFormat = formatList; imageFormat != NULL;
+ 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(options.format, imageFormat->name,
- strlen(imageFormat->name)) == 0)) {
+ || (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) {
@@ -1158,10 +1276,12 @@ ImgPhotoCmd(clientData, interp, argc, objv)
"has file writing capability", (char *) NULL);
} else if (!matched) {
Tcl_AppendResult(interp, "image file format \"",
- options.format, "\" is unknown", (char *) NULL);
+ Tcl_GetString(options.format),
+ "\" is unknown", (char *) NULL);
} else {
Tcl_AppendResult(interp, "image file format \"",
- options.format, "\" has no file writing capability",
+ Tcl_GetString(options.format),
+ "\" has no file writing capability",
(char *) NULL);
}
return TCL_ERROR;
@@ -1173,8 +1293,13 @@ ImgPhotoCmd(clientData, interp, argc, objv)
*/
data = ImgGetPhoto(masterPtr, &block, &options);
- result = (*imageFormat->fileWriteProc)(interp, options.name,
- options.format, &block);
+ 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);
}
@@ -1182,11 +1307,8 @@ ImgPhotoCmd(clientData, interp, argc, objv)
ckfree(data);
}
return result;
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be blank, cget, configure, copy, get, put,",
- " read, redither, or write", (char *) NULL);
- return TCL_ERROR;
+ break;
+ }
}
return TCL_OK;
@@ -1211,7 +1333,7 @@ ImgPhotoCmd(clientData, interp, argc, objv)
*/
static int
-ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
+ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, objc, objv)
struct SubcommandOptions *optPtr;
/* Information about the options specified
* and the values given is returned here. */
@@ -1219,27 +1341,27 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
int allowedOptions; /* Indicates which options are valid for
* the current command. */
int *optIndexPtr; /* Points to a variable containing the
- * current index in argv; this variable is
+ * current index in objv; this variable is
* updated by this procedure. */
- int argc; /* Number of arguments in argv[]. */
- char **argv; /* Arguments to be parsed. */
+ int objc; /* Number of arguments in objv[]. */
+ Tcl_Obj *CONST objv[]; /* Arguments to be parsed. */
{
int index, c, bit, currentBit;
- size_t length;
+ int length;
char *option, **listPtr;
int values[4];
int numValues, maxValues, argIndex;
- for (index = *optIndexPtr; index < argc; *optIndexPtr = ++index) {
+ for (index = *optIndexPtr; index < objc; *optIndexPtr = ++index) {
/*
* We can have one value specified without an option;
* it goes into optPtr->name.
*/
- option = argv[index];
+ option = Tcl_GetStringFromObj(objv[index], &length);
if (option[0] != '-') {
if (optPtr->name == NULL) {
- optPtr->name = option;
+ optPtr->name = objv[index];
continue;
}
break;
@@ -1249,13 +1371,12 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
* Work out which option this is.
*/
- length = strlen(option);
c = option[0];
bit = 0;
currentBit = 1;
for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
if ((c == *listPtr[0])
- && (strncmp(option, *listPtr, length) == 0)) {
+ && (strncmp(option, *listPtr, (size_t) length) == 0)) {
if (bit != 0) {
bit = 0; /* An ambiguous option. */
break;
@@ -1271,7 +1392,8 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
*/
if ((allowedOptions & bit) == 0) {
- Tcl_AppendResult(interp, "unrecognized option \"", argv[index],
+ Tcl_AppendResult(interp, "unrecognized option \"",
+ Tcl_GetString(objv[index]),
"\": must be ", (char *)NULL);
bit = 1;
for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
@@ -1300,10 +1422,10 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
* The -background option takes a single XColor value.
*/
- if (index + 1 < argc) {
+ if (index + 1 < objc) {
*optIndexPtr = ++index;
optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
- Tk_GetUid(argv[index]));
+ Tk_GetUid(Tcl_GetString(objv[index])));
if (!optPtr->background) {
return TCL_ERROR;
}
@@ -1317,22 +1439,26 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
* The -format option takes a single string value.
*/
- if (index + 1 < argc) {
+ if (index + 1 < objc) {
*optIndexPtr = ++index;
- optPtr->format = argv[index];
+ optPtr->format = objv[index];
} else {
Tcl_AppendResult(interp, "the \"-format\" 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 < argc) && (isdigit(UCHAR(argv[argIndex][0]))
- || ((argv[argIndex][0] == '-')
- && (isdigit(UCHAR(argv[argIndex][1])))))) {
- if (Tcl_GetInt(interp, argv[argIndex], &values[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;
}
@@ -1343,7 +1469,7 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
}
if (numValues == 0) {
- Tcl_AppendResult(interp, "the \"", argv[index], "\" option ",
+ Tcl_AppendResult(interp, "the \"", option, "\" option ",
"requires one ", maxValues == 2? "or two": "to four",
" integer values", (char *) NULL);
return TCL_ERROR;
@@ -1442,7 +1568,7 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
*
* Results:
* A standard Tcl return value. If TCL_ERROR is returned then
- * an error message is left in masterPtr->interp->result.
+ * an error message is left in the masterPtr->interp's result.
*
* Side effects:
* Existing instances of the image will be redisplayed to match
@@ -1452,38 +1578,48 @@ ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
*/
static int
-ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
+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 argc; /* Number of entries in argv. */
+ 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;
- char *oldFileString, *oldPaletteString, *oldFormat;
- Tcl_Obj *oldDataObj, *dataObj = NULL;
+ 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;
- static char **argv = NULL;
-
- if (argv) ckfree((char *) argv);
- argv = (char **) ckalloc((argc + 1) * sizeof(char *));
- for (i = 0, j = 0; i < argc; i++,j++) {
- argv[j] = Tcl_GetStringFromObj(objv[i], &length);
- if (argv[j][0] == '-' && argv[j][1] == 'd' &&
- strncmp(argv[j],"-data", length) == 0) {
- if (i < argc) {
- dataObj = objv[++i];
- j--;
+ char **args;
+ int oldformat;
+ Tcl_Obj *tempdata, *tempformat;
+
+ args = (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.
@@ -1494,7 +1630,7 @@ ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
*/
oldFileString = masterPtr->fileString;
- oldDataObj = (oldFileString == NULL) ? masterPtr->dataObj: NULL;
+ oldData = (oldFileString == NULL) ? masterPtr->dataString: NULL;
oldFormat = masterPtr->format;
oldPaletteString = masterPtr->palette;
oldGamma = masterPtr->gamma;
@@ -1504,9 +1640,11 @@ ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
*/
if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
- j, argv, (char *) masterPtr, flags) != TCL_OK) {
+ j, args, (char *) masterPtr, flags) != TCL_OK) {
+ ckfree((char *) args);
return TCL_ERROR;
}
+ ckfree((char *) args);
/*
* Regard the empty string for -file, -data or -format as the null
@@ -1517,22 +1655,30 @@ ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
ckfree(masterPtr->fileString);
masterPtr->fileString = NULL;
}
- if (dataObj) {
- if (dataObj->length) {
- Tcl_IncrRefCount(dataObj);
+ if (data) {
+ if (data->length
+ || (data->typePtr == Tcl_GetObjType("bytearray")
+ && data->internalRep.otherValuePtr != NULL)) {
+ Tcl_IncrRefCount(data);
} else {
- dataObj = NULL;
+ data = NULL;
}
- if (masterPtr->dataObj) {
- Tcl_DecrRefCount(masterPtr->dataObj);
+ if (masterPtr->dataString) {
+ Tcl_DecrRefCount(masterPtr->dataString);
}
- masterPtr->dataObj = dataObj;
+ masterPtr->dataString = data;
}
- if ((masterPtr->format != NULL) && (masterPtr->format[0] == 0)) {
- ckfree(masterPtr->format);
- masterPtr->format = NULL;
+ 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.
@@ -1567,15 +1713,23 @@ ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
!= TCL_OK) {
return TCL_ERROR;
}
+ if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
if (MatchFileFormat(interp, chan, masterPtr->fileString,
masterPtr->format, &imageFormat, &imageWidth,
- &imageHeight) != TCL_OK) {
+ &imageHeight, &oldformat) != TCL_OK) {
Tcl_Close(NULL, chan);
return TCL_ERROR;
}
ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ tempformat = masterPtr->format;
+ if (oldformat && tempformat) {
+ tempformat = (Tcl_Obj *) Tcl_GetString(tempformat);
+ }
result = (*imageFormat->fileReadProc)(interp, chan,
- masterPtr->fileString, masterPtr->format,
+ masterPtr->fileString, tempformat,
(Tk_PhotoHandle) masterPtr, 0, 0,
imageWidth, imageHeight, 0, 0);
Tcl_Close(NULL, chan);
@@ -1583,25 +1737,35 @@ ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
return TCL_ERROR;
}
+ Tcl_ResetResult(interp);
masterPtr->flags |= IMAGE_CHANGED;
}
- if ((masterPtr->fileString == NULL) && (masterPtr->dataObj != NULL)
- && ((masterPtr->dataObj != oldDataObj)
+ if ((masterPtr->fileString == NULL) && (masterPtr->dataString != NULL)
+ && ((masterPtr->dataString != oldData)
|| (masterPtr->format != oldFormat))) {
- if (MatchStringFormat(interp, masterPtr->dataObj,
+ if (MatchStringFormat(interp, masterPtr->dataString,
masterPtr->format, &imageFormat, &imageWidth,
- &imageHeight) != TCL_OK) {
+ &imageHeight, &oldformat) != TCL_OK) {
return TCL_ERROR;
}
ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
- if ((*imageFormat->stringReadProc)(interp, masterPtr->dataObj,
- masterPtr->format, (Tk_PhotoHandle) masterPtr,
+ 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) {
return TCL_ERROR;
}
+ Tcl_ResetResult(interp);
masterPtr->flags |= IMAGE_CHANGED;
}
@@ -1814,7 +1978,7 @@ ImgPhotoGet(tkwin, masterData)
int mono, nRed, nGreen, nBlue;
XVisualInfo visualInfo, *visInfoPtr;
XRectangle validBox;
- char buf[16];
+ char buf[TCL_INTEGER_SPACE * 3];
int numVisuals;
XColor *white, *black;
XGCValues gcValues;
@@ -1955,9 +2119,8 @@ ImgPhotoGet(tkwin, masterData)
gcValues.background = (black != NULL)? black->pixel:
BlackPixelOfScreen(Tk_Screen(tkwin));
gcValues.graphics_exposures = False;
- instancePtr->gc = Tk_GetGCColor(tkwin,
- GCForeground|GCBackground|GCGraphicsExposures, &gcValues,
- white, black);
+ instancePtr->gc = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
/*
* Set configuration options and finish the initialization of the instance.
*/
@@ -2133,8 +2296,11 @@ ImgPhotoDelete(masterData)
if (masterPtr->validRegion != NULL) {
TkDestroyRegion(masterPtr->validRegion);
}
- if (masterPtr->dataObj != NULL) {
- Tcl_DecrRefCount(masterPtr->dataObj);
+ 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);
@@ -3225,20 +3391,29 @@ DisposeInstance(clientData)
*/
static int
-MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
- widthPtr, heightPtr)
+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. */
- char *formatString; /* User-specified format string, or NULL. */
+ 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
@@ -3246,11 +3421,11 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
*/
matched = 0;
- for (formatPtr = formatList; formatPtr != NULL;
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
formatPtr = formatPtr->nextPtr) {
- if (formatString != NULL) {
- if (strncasecmp(formatString, formatPtr->name,
- strlen(formatPtr->name)) != 0) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
continue;
}
matched = 1;
@@ -3263,8 +3438,8 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
if (formatPtr->fileMatchProc != NULL) {
(void) Tcl_Seek(chan, 0L, SEEK_SET);
- if ((*formatPtr->fileMatchProc)(chan, fileName, formatString,
- widthPtr, heightPtr)) {
+ if ((*formatPtr->fileMatchProc)(chan, fileName, formatObj,
+ widthPtr, heightPtr, interp)) {
if (*widthPtr < 1) {
*widthPtr = 1;
}
@@ -3275,10 +3450,42 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
}
}
}
+ 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, 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 ((formatString != NULL) && !matched) {
- Tcl_AppendResult(interp, "image file format \"", formatString,
+ if ((formatObj != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image file format \"",
+ formatString,
"\" is not supported", (char *) NULL);
} else {
Tcl_AppendResult(interp,
@@ -3289,6 +3496,7 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
}
*imageFormatPtr = formatPtr;
+ *oldformat = useoldformat;
(void) Tcl_Seek(chan, 0L, SEEK_SET);
return TCL_OK;
}
@@ -3316,19 +3524,28 @@ MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
*/
static int
-MatchStringFormat(interp, dataObj, formatString, imageFormatPtr,
- widthPtr, heightPtr)
+MatchStringFormat(interp, data, formatObj, imageFormatPtr,
+ widthPtr, heightPtr, oldformat)
Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
- Tcl_Obj *dataObj; /* Object containing the image data. */
- char *formatString; /* User-specified format string, or NULL. */
+ 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
@@ -3336,11 +3553,11 @@ MatchStringFormat(interp, dataObj, formatString, imageFormatPtr,
*/
matched = 0;
- for (formatPtr = formatList; formatPtr != NULL;
+ for (formatPtr = tsdPtr->formatList; formatPtr != NULL;
formatPtr = formatPtr->nextPtr) {
- if (formatString != NULL) {
- if (strncasecmp(formatString, formatPtr->name,
- strlen(formatPtr->name)) != 0) {
+ if (formatObj != NULL) {
+ if (strncasecmp(formatString,
+ formatPtr->name, strlen(formatPtr->name)) != 0) {
continue;
}
matched = 1;
@@ -3352,15 +3569,41 @@ MatchStringFormat(interp, dataObj, formatString, imageFormatPtr,
}
if ((formatPtr->stringMatchProc != NULL)
&& (formatPtr->stringReadProc != NULL)
- && (*formatPtr->stringMatchProc)(dataObj, formatString,
- widthPtr, heightPtr)) {
+ && (*formatPtr->stringMatchProc)(data, formatObj,
+ widthPtr, heightPtr, interp)) {
break;
}
}
if (formatPtr == NULL) {
- if ((formatString != NULL) && !matched) {
- Tcl_AppendResult(interp, "image format \"", formatString,
+ 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",
@@ -3370,6 +3613,7 @@ MatchStringFormat(interp, dataObj, formatString, imageFormatPtr,
}
*imageFormatPtr = formatPtr;
+ *oldformat = useoldformat;
return TCL_OK;
}
@@ -3482,13 +3726,8 @@ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height)
greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
- alphaOffset = 0;
- while ((alphaOffset != blockPtr->offset[0]) &&
- (alphaOffset != blockPtr->offset[1]) &&
- (alphaOffset != blockPtr->offset[2])) {
- alphaOffset++;
- }
- if (alphaOffset >= blockPtr->pixelSize) {
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
alphaOffset = 0;
} else {
alphaOffset -= blockPtr->offset[0];
@@ -3505,7 +3744,13 @@ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height)
destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
pitch = masterPtr->width * 4;
- if ((blockPtr->pixelSize == 4) && (greenOffset == 1) && (blueOffset == 2)
+ /*
+ * 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)))) {
@@ -3524,11 +3769,24 @@ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height)
wLeft -= wCopy;
srcPtr = srcLinePtr;
for (; wCopy > 0; --wCopy) {
+ if (!destPtr[3]) {
+ destPtr[0] = destPtr[1] = destPtr[2] = 0xd9;
+ }
+ if (!alphaOffset || (srcPtr[alphaOffset] == 255)) {
*destPtr++ = srcPtr[0];
*destPtr++ = srcPtr[greenOffset];
*destPtr++ = srcPtr[blueOffset];
- *destPtr++ = alphaOffset ? srcPtr[alphaOffset] : 255;
- srcPtr += blockPtr->pixelSize;
+ *destPtr++ = 255;
+ } else {
+ 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;
+ }
+ srcPtr += blockPtr->pixelSize;
}
}
srcLinePtr += blockPtr->pitch;
@@ -3541,18 +3799,67 @@ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height)
* 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 transparent pixels, then marks those
+ * areas as invalid 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.
+ */
+
+ 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.
*/
- Dither(masterPtr, x, y, width, height);
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, x, y, width, height);
/*
* Tell the core image code that this image has changed.
@@ -3656,13 +3963,8 @@ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
- alphaOffset = 0;
- while ((alphaOffset != blockPtr->offset[0]) &&
- (alphaOffset != blockPtr->offset[1]) &&
- (alphaOffset != blockPtr->offset[2])) {
- alphaOffset++;
- }
- if (alphaOffset >= blockPtr->pixelSize) {
+ alphaOffset = blockPtr->offset[3];
+ if ((alphaOffset >= blockPtr->pixelSize) || (alphaOffset < 0)) {
alphaOffset = 0;
} else {
alphaOffset -= blockPtr->offset[0];
@@ -3718,10 +4020,23 @@ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
srcPtr = srcLinePtr;
for (; wCopy > 0; wCopy -= zoomX) {
for (xRepeat = MIN(wCopy, zoomX); xRepeat > 0; xRepeat--) {
+ if (!destPtr[3]) {
+ destPtr[0] = destPtr[1] = destPtr[2] = 0xd9;
+ }
+ if (!alphaOffset || (srcPtr[alphaOffset] == 255)) {
*destPtr++ = srcPtr[0];
*destPtr++ = srcPtr[greenOffset];
*destPtr++ = srcPtr[blueOffset];
- *destPtr++ = alphaOffset ? srcPtr[alphaOffset] : 255;
+ *destPtr++ = 255;
+ } else {
+ 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;
+ }
}
srcPtr += blockXSkip;
}
@@ -3739,18 +4054,49 @@ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
* Add this new block to the region that specifies which data is valid.
*/
+ if (alphaOffset) {
+ int x1, y1, end;
+
+ 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.
*/
- Dither(masterPtr, x, y, width, height);
+ Tk_DitherPhoto((Tk_PhotoHandle)masterPtr, x, y, width, height);
/*
* Tell the core image code that this image has changed.
@@ -3763,7 +4109,7 @@ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
/*
*----------------------------------------------------------------------
*
- * Dither --
+ * Tk_DitherPhoto --
*
* This procedure is called to update an area of each instance's
* pixmap by dithering the corresponding area of the image master.
@@ -3779,14 +4125,15 @@ Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
*----------------------------------------------------------------------
*/
-static void
-Dither(masterPtr, x, y, width, height)
- PhotoMaster *masterPtr; /* Image master whose instances are
+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)) {
@@ -4431,7 +4778,8 @@ ImgGetPhoto(masterPtr, blockPtr, optPtr)
if ((greenOffset || blueOffset) && !(optPtr->options & OPT_GRAYSCALE)) {
newPixelSize += 2;
}
- data = ckalloc(newPixelSize * blockPtr->width * blockPtr->height);
+ data = ckalloc((unsigned int) (newPixelSize *
+ blockPtr->width * blockPtr->height));
srcPtr = blockPtr->pixelPtr + blockPtr->offset[0];
destPtr = (unsigned char *) data;
if (!greenOffset && !blueOffset) {
@@ -4546,22 +4894,23 @@ ImgGetPhoto(masterPtr, blockPtr, optPtr)
*/
static int
-ImgStringWrite (interp, dataPtr, formatString, blockPtr)
+ImgStringWrite(interp, formatString, blockPtr)
Tcl_Interp *interp;
- Tcl_DString *dataPtr;
- char *formatString;
+ 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(8 * blockPtr->width + 2);
+ 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;
@@ -4572,10 +4921,11 @@ ImgStringWrite (interp, dataPtr, formatString, blockPtr)
pixelPtr += blockPtr->pixelSize;
linePtr += 8;
}
- Tcl_DStringAppendElement(dataPtr, line+1);
+ Tcl_DStringAppendElement(&data, line+1);
}
ckfree (line);
}
+ Tcl_DStringResult(interp, &data);
return TCL_OK;
}
@@ -4618,5 +4968,189 @@ Tk_PhotoGetImage(handle, blockPtr)
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;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ Tk_PostscriptInfo psInfo; /* postscript info */
+ int x, y; /* First pixel to output */
+ int width, height; /* Width and height of area */
+ int prepass;
+{
+ 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);
+}
+
diff --git a/tk/generic/tkImgUtil.c b/tk/generic/tkImgUtil.c
index b865c9ca18f..810611ddded 100644
--- a/tk/generic/tkImgUtil.c
+++ b/tk/generic/tkImgUtil.c
@@ -76,3 +76,4 @@ TkAlignImageData(image, alignment, bitOrder)
}
return data;
}
+
diff --git a/tk/generic/tkInitScript.h b/tk/generic/tkInitScript.h
index 959ebea448d..0ff30077918 100644
--- a/tk/generic/tkInitScript.h
+++ b/tk/generic/tkInitScript.h
@@ -12,6 +12,8 @@
* RCS: @(#) $Id$
*/
+
+
/*
* In order to find tk.tcl during initialization, the following script
* is invoked by Tk_Init(). It looks in several different directories:
@@ -46,11 +48,12 @@
*/
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\
+ proc tkInit {} {\n\
+ global tk_library tk_version tk_patchLevel\n\
+ rename tkInit {}\n\
+ tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\
+}\n\
}\n\
tkInit";
+
diff --git a/tk/generic/tkInt.decls b/tk/generic/tkInt.decls
new file mode 100644
index 00000000000..b4d3d470477
--- /dev/null
+++ b/tk/generic/tkInt.decls
@@ -0,0 +1,1932 @@
+ # 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, char *eventString, \
+ TkBindEvalProc *evalProc, TkBindFreeProc *freeProc, \
+ ClientData clientData)
+}
+
+declare 12 generic {
+ TkCursor * TkCreateCursorFromData (Tk_Window tkwin, \
+ char *source, char *mask, int width, int height, \
+ int xHot, int yHot, XColor fg, XColor bg)
+}
+
+declare 13 generic {
+ int TkCreateFrame (ClientData clientData, \
+ Tcl_Interp *interp, int argc, char **argv, \
+ int toplevel, char *appName)
+}
+
+declare 14 generic {
+ Tk_Window TkCreateMainWindow (Tcl_Interp *interp, \
+ char *screenName, char *baseName)
+}
+
+declare 15 generic {
+ Time TkCurrentTime (TkDisplay *dispPtr)
+}
+
+declare 16 generic {
+ void TkDeleteAllImages (TkMainInfo *mainPtr)
+}
+
+declare 17 generic {
+ void TkDoConfigureNotify (TkWindow *winPtr)
+}
+
+declare 18 generic {
+ void TkDrawInsetFocusHighlight (Tk_Window tkwin, GC gc, int width, \
+ Drawable drawable, int padding)
+}
+
+declare 19 generic {
+ void TkEventDeadWindow (TkWindow *winPtr)
+}
+
+declare 20 generic {
+ void TkFillPolygon (Tk_Canvas canvas, \
+ double *coordPtr, int numPoints, Display *display, \
+ Drawable drawable, GC gc, GC outlineGC)
+}
+
+declare 21 generic {
+ int TkFindStateNum (Tcl_Interp *interp, \
+ CONST char *option, CONST TkStateMap *mapPtr, \
+ CONST char *strKey)
+}
+
+declare 22 generic {
+ char * TkFindStateString (CONST TkStateMap *mapPtr, int numKey)
+}
+
+declare 23 generic {
+ void TkFocusDeadWindow (TkWindow *winPtr)
+}
+
+declare 24 generic {
+ int TkFocusFilterEvent (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 25 generic {
+ TkWindow * TkFocusKeyEvent (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 26 generic {
+ void TkFontPkgInit (TkMainInfo *mainPtr)
+}
+
+declare 27 generic {
+ void TkFontPkgFree (TkMainInfo *mainPtr)
+}
+
+declare 28 generic {
+ void TkFreeBindingTags (TkWindow *winPtr)
+}
+
+# Name change only, TkFreeCursor in Tcl 8.0.x now TkpFreeCursor
+declare 29 generic {
+ void TkpFreeCursor (TkCursor *cursorPtr)
+}
+
+declare 30 generic {
+ char * TkGetBitmapData (Tcl_Interp *interp, \
+ char *string, char *fileName, int *widthPtr, \
+ int *heightPtr, int *hotXPtr, int *hotYPtr)
+}
+
+declare 31 generic {
+ void TkGetButtPoints (double p1[], double p2[], \
+ double width, int project, double m1[], double m2[])
+}
+
+declare 32 generic {
+ TkCursor * TkGetCursorByName (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tk_Uid string)
+}
+
+declare 33 generic {
+ char * TkGetDefaultScreenName (Tcl_Interp *interp, char *screenName)
+}
+
+declare 34 generic {
+ TkDisplay * TkGetDisplay (Display *display)
+}
+
+declare 35 generic {
+ int TkGetDisplayOf (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], \
+ Tk_Window *tkwinPtr)
+}
+
+declare 36 generic {
+ TkWindow * TkGetFocusWin (TkWindow *winPtr)
+}
+
+declare 37 generic {
+ int TkGetInterpNames (Tcl_Interp *interp, Tk_Window tkwin)
+}
+
+declare 38 generic {
+ int TkGetMiterPoints (double p1[], double p2[], double p3[], \
+ double width, double m1[],double m2[])
+}
+
+declare 39 generic {
+ void TkGetPointerCoords (Tk_Window tkwin, int *xPtr, int *yPtr)
+}
+
+declare 40 generic {
+ void TkGetServerInfo (Tcl_Interp *interp, Tk_Window tkwin)
+}
+
+declare 41 generic {
+ void TkGrabDeadWindow (TkWindow *winPtr)
+}
+
+declare 42 generic {
+ int TkGrabState (TkWindow *winPtr)
+}
+
+declare 43 generic {
+ void TkIncludePoint (Tk_Item *itemPtr, double *pointPtr)
+}
+
+declare 44 generic {
+ void TkInOutEvents (XEvent *eventPtr, TkWindow *sourcePtr, \
+ TkWindow *destPtr, int leaveType, int enterType, \
+ Tcl_QueuePosition position)
+}
+
+declare 45 generic {
+ void TkInstallFrameMenu (Tk_Window tkwin)
+}
+
+declare 46 generic {
+ char * TkKeysymToString (KeySym keysym)
+}
+
+declare 47 generic {
+ int TkLineToArea (double end1Ptr[], double end2Ptr[], double rectPtr[])
+}
+
+declare 48 generic {
+ double TkLineToPoint (double end1Ptr[], \
+ double end2Ptr[], double pointPtr[])
+}
+
+declare 49 generic {
+ int TkMakeBezierCurve (Tk_Canvas canvas, \
+ double *pointPtr, int numPoints, int numSteps, \
+ XPoint xPoints[], double dblPoints[])
+}
+
+declare 50 generic {
+ void TkMakeBezierPostscript (Tcl_Interp *interp, \
+ Tk_Canvas canvas, double *pointPtr, int numPoints)
+}
+
+declare 51 generic {
+ void TkOptionClassChanged (TkWindow *winPtr)
+}
+
+declare 52 generic {
+ void TkOptionDeadWindow (TkWindow *winPtr)
+}
+
+declare 53 generic {
+ int TkOvalToArea (double *ovalPtr, double *rectPtr)
+}
+
+declare 54 generic {
+ double TkOvalToPoint (double ovalPtr[], \
+ double width, int filled, double pointPtr[])
+}
+
+declare 55 generic {
+ int TkpChangeFocus (TkWindow *winPtr, int force)
+}
+
+declare 56 generic {
+ void TkpCloseDisplay (TkDisplay *dispPtr)
+}
+
+declare 57 generic {
+ void TkpClaimFocus (TkWindow *topLevelPtr, int force)
+}
+
+declare 58 generic {
+ void TkpDisplayWarning (char *msg, char *title)
+}
+
+declare 59 generic {
+ void TkpGetAppName (Tcl_Interp *interp, Tcl_DString *name)
+}
+
+declare 60 generic {
+ TkWindow * TkpGetOtherWindow (TkWindow *winPtr)
+}
+
+declare 61 generic {
+ TkWindow * TkpGetWrapperWindow (TkWindow *winPtr)
+}
+
+declare 62 generic {
+ int TkpInit (Tcl_Interp *interp)
+}
+
+declare 63 generic {
+ void TkpInitializeMenuBindings (Tcl_Interp *interp, \
+ Tk_BindingTable bindingTable)
+}
+
+declare 64 generic {
+ void TkpMakeContainer (Tk_Window tkwin)
+}
+
+declare 65 generic {
+ void TkpMakeMenuWindow (Tk_Window tkwin, int transient)
+}
+
+declare 66 generic {
+ Window TkpMakeWindow (TkWindow *winPtr, Window parent)
+}
+
+declare 67 generic {
+ void TkpMenuNotifyToplevelCreate (Tcl_Interp *interp1, char *menuName)
+}
+
+declare 68 generic {
+ TkDisplay * TkpOpenDisplay (char *display_name)
+}
+
+declare 69 generic {
+ int TkPointerEvent (XEvent *eventPtr, TkWindow *winPtr)
+}
+
+declare 70 generic {
+ int TkPolygonToArea (double *polyPtr, int numPoints, double *rectPtr)
+}
+
+declare 71 generic {
+ double TkPolygonToPoint (double *polyPtr, int numPoints, double *pointPtr)
+}
+
+declare 72 generic {
+ int TkPositionInTree (TkWindow *winPtr, TkWindow *treePtr)
+}
+
+declare 73 generic {
+ void TkpRedirectKeyEvent (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 74 generic {
+ void TkpSetMainMenubar (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *menuName)
+}
+
+declare 75 generic {
+ int TkpUseWindow (Tcl_Interp *interp, Tk_Window tkwin, char *string)
+}
+
+declare 76 generic {
+ int TkpWindowWasRecentlyDeleted (Window win, TkDisplay *dispPtr)
+}
+
+declare 77 generic {
+ void TkQueueEventForAllChildren (TkWindow *winPtr, XEvent *eventPtr)
+}
+
+declare 78 generic {
+ int TkReadBitmapFile (Display* display, Drawable d, CONST char* filename, \
+ unsigned int* width_return, unsigned int* height_return, \
+ Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)
+}
+
+declare 79 generic {
+ int TkScrollWindow (Tk_Window tkwin, GC gc, \
+ int x, int y, int width, int height, int dx, \
+ int dy, TkRegion damageRgn)
+}
+
+declare 80 generic {
+ void TkSelDeadWindow (TkWindow *winPtr)
+}
+
+declare 81 generic {
+ void TkSelEventProc (Tk_Window tkwin, XEvent *eventPtr)
+}
+
+declare 82 generic {
+ void TkSelInit (Tk_Window tkwin)
+}
+
+declare 83 generic {
+ void TkSelPropProc (XEvent *eventPtr)
+}
+
+declare 84 generic {
+ void TkSetClassProcs (Tk_Window tkwin, \
+ TkClassProcs *procs, ClientData instanceData)
+}
+
+declare 85 generic {
+ void TkSetWindowMenuBar (Tcl_Interp *interp, \
+ Tk_Window tkwin, char *oldMenuName, char *menuName)
+}
+
+declare 86 generic {
+ KeySym TkStringToKeysym (char *name)
+}
+
+declare 87 generic {
+ int TkThickPolyLineToArea (double *coordPtr, \
+ int numPoints, double width, int capStyle, \
+ int joinStyle, double *rectPtr)
+}
+
+declare 88 generic {
+ void TkWmAddToColormapWindows (TkWindow *winPtr)
+}
+
+declare 89 generic {
+ void TkWmDeadWindow (TkWindow *winPtr)
+}
+
+declare 90 generic {
+ TkWindow * TkWmFocusToplevel (TkWindow *winPtr)
+}
+
+declare 91 generic {
+ void TkWmMapWindow (TkWindow *winPtr)
+}
+
+declare 92 generic {
+ void TkWmNewWindow (TkWindow *winPtr)
+}
+
+declare 93 generic {
+ void TkWmProtocolEventProc (TkWindow *winPtr, XEvent *evenvPtr)
+}
+
+declare 94 generic {
+ void TkWmRemoveFromColormapWindows (TkWindow *winPtr)
+}
+
+declare 95 generic {
+ void TkWmRestackToplevel (TkWindow *winPtr, int aboveBelow, \
+ TkWindow *otherPtr)
+}
+
+declare 96 generic {
+ void TkWmSetClass (TkWindow *winPtr)
+}
+
+declare 97 generic {
+ void TkWmUnmapWindow (TkWindow *winPtr)
+}
+
+# new for 8.1
+
+declare 98 generic {
+ Tcl_Obj * TkDebugBitmap ( Tk_Window tkwin, char *name)
+}
+
+declare 99 generic {
+ Tcl_Obj * TkDebugBorder ( Tk_Window tkwin, char *name)
+}
+
+declare 100 generic {
+ Tcl_Obj * TkDebugCursor ( Tk_Window tkwin, char *name)
+}
+
+declare 101 generic {
+ Tcl_Obj * TkDebugColor ( Tk_Window tkwin, char *name)
+}
+
+declare 102 generic {
+ Tcl_Obj * TkDebugConfig (Tcl_Interp *interp, Tk_OptionTable table)
+}
+
+declare 103 generic {
+ Tcl_Obj * TkDebugFont ( Tk_Window tkwin, char *name)
+}
+
+declare 104 generic {
+ int TkFindStateNumObj (Tcl_Interp *interp, \
+ Tcl_Obj *optionPtr, CONST TkStateMap *mapPtr, \
+ Tcl_Obj *keyPtr)
+}
+
+declare 105 generic {
+ Tcl_HashTable * TkGetBitmapPredefTable (void)
+}
+
+declare 106 generic {
+ TkDisplay * TkGetDisplayList (void)
+}
+
+declare 107 generic {
+ TkMainInfo * TkGetMainInfoList (void)
+}
+
+declare 108 generic {
+ int TkGetWindowFromObj (Tcl_Interp *interp, \
+ Tk_Window tkwin, Tcl_Obj *objPtr, \
+ Tk_Window *windowPtr)
+}
+
+declare 109 generic {
+ char * TkpGetString (TkWindow *winPtr, \
+ XEvent *eventPtr, Tcl_DString *dsPtr)
+}
+
+declare 110 generic {
+ void TkpGetSubFonts (Tcl_Interp *interp, Tk_Font tkfont)
+}
+
+declare 111 generic {
+ Tcl_Obj * TkpGetSystemDefault (Tk_Window tkwin, \
+ char *dbName, char *className)
+}
+
+declare 112 generic {
+ void TkpMenuThreadInit (void)
+}
+
+declare 113 win {
+ void TkClipBox (TkRegion rgn, XRectangle* rect_return)
+}
+
+declare 113 mac {
+ void TkClipBox (TkRegion rgn, XRectangle* rect_return)
+}
+
+declare 114 win {
+ TkRegion TkCreateRegion (void)
+}
+
+declare 114 mac {
+ TkRegion TkCreateRegion (void)
+}
+
+declare 115 win {
+ void TkDestroyRegion (TkRegion rgn)
+}
+
+declare 115 mac {
+ void TkDestroyRegion (TkRegion rgn)
+}
+
+declare 116 win {
+ void TkIntersectRegion (TkRegion sra, TkRegion srcb, TkRegion dr_return)
+}
+
+declare 116 mac {
+ void TkIntersectRegion (TkRegion sra, TkRegion srcb, TkRegion dr_return)
+}
+
+declare 117 win {
+ int TkRectInRegion (TkRegion rgn, int x, int y, unsigned int width, \
+ unsigned int height)
+}
+
+declare 117 mac {
+ int TkRectInRegion (TkRegion rgn, int x, int y, unsigned int width, \
+ unsigned int height)
+}
+
+declare 118 win {
+ void TkSetRegion (Display* display, GC gc, TkRegion rgn)
+}
+
+declare 118 mac {
+ void TkSetRegion (Display* display, GC gc, TkRegion rgn)
+}
+
+declare 119 win {
+ void TkUnionRectWithRegion (XRectangle* rect, \
+ TkRegion src, TkRegion dr_return)
+}
+
+declare 119 mac {
+ void TkUnionRectWithRegion (XRectangle* rect, \
+ TkRegion src, TkRegion dr_return)
+}
+
+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)
+}
+
+##############################################################################
+
+# Define the platform specific internal Tcl interface. These functions are
+# only available on the designated platform.
+
+interface tkIntPlat
+
+#########################
+# Unix specific functions
+
+declare 0 unix {
+ void TkCreateXEventSource (void)
+}
+
+declare 1 unix {
+ void TkFreeWindowId (TkDisplay *dispPtr, Window w)
+}
+
+declare 2 unix {
+ void TkInitXId (TkDisplay *dispPtr)
+}
+
+declare 3 unix {
+ int TkpCmapStressed (Tk_Window tkwin, Colormap colormap)
+}
+
+declare 4 unix {
+ void TkpSync (Display *display)
+}
+
+declare 5 unix {
+ Window TkUnixContainerId (TkWindow *winPtr)
+}
+
+declare 6 unix {
+ int TkUnixDoOneXEvent (Tcl_Time *timePtr)
+}
+
+declare 7 unix {
+ void TkUnixSetMenubar (Tk_Window tkwin, Tk_Window menubar)
+}
+
+
+
+############################
+# Windows specific functions
+
+declare 0 win {
+ char * TkAlignImageData (XImage *image, int alignment, int bitOrder)
+}
+
+declare 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, char *string, int *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, \
+ char *dbName, char *className)
+}
+
+declare 33 win {
+ int TkWinGetPlatformId(void)
+}
+
+########################
+# Mac specific functions
+
+declare 0 mac {
+ void TkGenerateActivateEvents (TkWindow *winPtr, int active)
+}
+
+declare 1 mac {
+ Pixmap TkpCreateNativeBitmap (Display *display, char * source)
+}
+
+declare 2 mac {
+ void TkpDefineNativeBitmaps (void)
+}
+
+declare 3 mac {
+ unsigned long TkpGetMS (void)
+}
+
+declare 4 mac {
+ Pixmap TkpGetNativeAppBitmap (Display *display, \
+ char *name, int *width, int *height)
+}
+
+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 9 mac {
+ int HandleWMEvent (EventRecord *theEvent)
+}
+
+declare 10 mac {
+ void TkAboutDlg (void)
+}
+
+declare 11 mac {
+ void TkCreateMacEventSource (void)
+}
+
+declare 12 mac {
+ void TkFontList (Tcl_Interp *interp, Display *display)
+}
+
+declare 13 mac {
+ Window TkGetTransientMaster (TkWindow *winPtr)
+}
+
+declare 14 mac {
+ int TkGenerateButtonEvent (int x, int y, \
+ Window window, unsigned int state)
+}
+
+declare 15 mac {
+ int TkGetCharPositions (XFontStruct *font_struct, char *string, \
+ int count, short *buffer)
+}
+
+declare 16 mac {
+ void TkGenWMDestroyEvent (Tk_Window tkwin)
+}
+
+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)
+}
+
+declare 20 mac {
+ int TkMacConvertEvent (EventRecord *eventPtr)
+}
+
+declare 21 mac {
+ int TkMacDispatchMenuEvent (int menuID, int index)
+}
+
+declare 22 mac {
+ void TkMacInstallCursor (int resizeOverride)
+}
+
+declare 23 mac {
+ int TkMacConvertTkEvent (EventRecord *eventPtr, Window window)
+}
+
+declare 24 mac {
+ void TkMacHandleTearoffMenu (void)
+}
+
+declare 25 mac {
+ void tkMacInstallMWConsole (Tcl_Interp *interp)
+}
+
+declare 26 mac {
+ void TkMacInvalClipRgns (TkWindow *winPtr)
+}
+
+declare 27 mac {
+ void TkMacDoHLEvent (EventRecord *theEvent)
+}
+
+declare 28 mac {
+ void TkMacFontInfo (Font fontId, short *family, \
+ short *style, short *size)
+}
+
+declare 29 mac {
+ Time TkMacGenerateTime (void)
+}
+
+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)
+}
+
+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 45 mac {
+ void TkMacSetEmbedRgn (TkWindow *winPtr, RgnHandle rgn)
+}
+
+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 56 mac {
+ void TkResumeClipboard (void)
+}
+
+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 60 mac {
+ int TkWMGrowToplevel (WindowRef whichWindow, Point start)
+}
+
+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)
+}
+
+
+##############################################################################
+
+# Define the platform specific internal Xlib interfaces. These functions are
+# only available on the designated platform.
+
+interface tkIntXlib
+
+# X functions for Windows
+
+# This slot is reserved for use by the dash patch:
+# declare 0 win {
+# XSetDashes
+# }
+declare 1 win {
+ XModifierKeymap* XGetModifierMapping (Display* d)
+}
+
+declare 2 win {
+ XImage * XCreateImage (Display* d, Visual* v, unsigned int ui1, int i1, \
+ int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, \
+ int i4)
+
+}
+
+declare 3 win {
+ XImage *XGetImage (Display* d, Drawable dr, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
+}
+
+declare 4 win {
+ char *XGetAtomName (Display* d,Atom a)
+
+}
+
+declare 5 win {
+ char *XKeysymToString (KeySym k)
+}
+
+declare 6 win {
+ Colormap XCreateColormap (Display* d, Window w, Visual* v, int i)
+
+}
+
+declare 7 win {
+ Cursor XCreatePixmapCursor (Display* d, Pixmap p1, Pixmap p2, \
+ XColor* x1, XColor* x2, \
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 8 win {
+ Cursor XCreateGlyphCursor (Display* d, Font f1, Font f2, \
+ unsigned int ui1, unsigned int ui2, XColor* x1, XColor* x2)
+}
+
+declare 9 win {
+ GContext XGContextFromGC (GC g)
+}
+
+declare 10 win {
+ XHostAddress *XListHosts (Display* d, int* i, Bool* b)
+}
+
+# second parameter was of type KeyCode
+declare 11 win {
+ KeySym XKeycodeToKeysym (Display* d, unsigned int k, int i)
+}
+
+declare 12 win {
+ KeySym XStringToKeysym (_Xconst char* c)
+}
+
+declare 13 win {
+ Window XRootWindow (Display* d, int i)
+}
+
+declare 14 win {
+ XErrorHandler XSetErrorHandler (XErrorHandler x)
+}
+
+declare 15 win {
+ Status XIconifyWindow (Display* d, Window w, int i)
+}
+
+declare 16 win {
+ Status XWithdrawWindow (Display* d, Window w, int i)
+}
+
+declare 17 win {
+ Status XGetWMColormapWindows (Display* d, Window w, Window** wpp, int* ip)
+}
+
+declare 18 win {
+ Status XAllocColor (Display* d, Colormap c, XColor* xp)
+}
+
+declare 19 win {
+ void XBell (Display* d, int i)
+}
+
+declare 20 win {
+ void XChangeProperty (Display* d, Window w, Atom a1, Atom a2, int i1, \
+ int i2, _Xconst unsigned char* c, int i3)
+}
+
+declare 21 win {
+ void XChangeWindowAttributes (Display* d, Window w, unsigned long ul, \
+ XSetWindowAttributes* x)
+}
+
+declare 22 win {
+ void XClearWindow (Display* d, Window w)
+}
+
+declare 23 win {
+ void XConfigureWindow (Display* d, Window w, unsigned int i, \
+ XWindowChanges* x)
+}
+
+declare 24 win {
+ void XCopyArea (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4)
+}
+
+declare 25 win {
+ void XCopyPlane (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4, unsigned long ul)
+}
+
+declare 26 win {
+ Pixmap XCreateBitmapFromData(Display* display, Drawable d, \
+ _Xconst char* data, unsigned int width,unsigned int height)
+}
+
+declare 27 win {
+ void XDefineCursor (Display* d, Window w, Cursor c)
+}
+
+declare 28 win {
+ void XDeleteProperty (Display* d, Window w, Atom a)
+}
+
+declare 29 win {
+ void XDestroyWindow (Display* d, Window w)
+}
+
+declare 30 win {
+ void XDrawArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 31 win {
+ void XDrawLines (Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)
+}
+
+declare 32 win {
+ void XDrawRectangle (Display* d, Drawable dr, GC g, int i1, int i2,\
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 33 win {
+ void XFillArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 34 win {
+ void XFillPolygon (Display* d, Drawable dr, GC g, XPoint* x, \
+ int i1, int i2, int i3)
+}
+
+declare 35 win {
+ void XFillRectangles (Display* d, Drawable dr, GC g, XRectangle* x, int i)
+}
+
+declare 36 win {
+ void XForceScreenSaver (Display* d, int i)
+}
+
+declare 37 win {
+ void XFreeColormap (Display* d, Colormap c)
+}
+
+declare 38 win {
+ void XFreeColors (Display* d, Colormap c, \
+ unsigned long* ulp, int i, unsigned long ul)
+}
+
+declare 39 win {
+ void XFreeCursor (Display* d, Cursor c)
+}
+
+declare 40 win {
+ void XFreeModifiermap (XModifierKeymap* x)
+}
+
+declare 41 win {
+ Status XGetGeometry (Display* d, Drawable dr, Window* w, int* i1, \
+ int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, \
+ unsigned int* ui4)
+}
+
+declare 42 win {
+ void XGetInputFocus (Display* d, Window* w, int* i)
+}
+
+declare 43 win {
+ int XGetWindowProperty (Display* d, Window w, Atom a1, long l1, long l2, \
+ Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, \
+ unsigned long* ulp2, unsigned char** cpp)
+}
+
+declare 44 win {
+ Status XGetWindowAttributes (Display* d, Window w, XWindowAttributes* x)
+}
+
+declare 45 win {
+ int XGrabKeyboard (Display* d, Window w, Bool b, int i1, int i2, Time t)
+}
+
+declare 46 win {
+ int XGrabPointer (Display* d, Window w1, Bool b, unsigned int ui, \
+ int i1, int i2, Window w2, Cursor c, Time t)
+}
+
+declare 47 win {
+ KeyCode XKeysymToKeycode (Display* d, KeySym k)
+}
+
+declare 48 win {
+ Status XLookupColor (Display* d, Colormap c1, _Xconst char* c2, \
+ XColor* x1, XColor* x2)
+}
+
+declare 49 win {
+ void XMapWindow (Display* d, Window w)
+}
+
+declare 50 win {
+ void XMoveResizeWindow (Display* d, Window w, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 51 win {
+ void XMoveWindow (Display* d, Window w, int i1, int i2)
+}
+
+declare 52 win {
+ void XNextEvent (Display* d, XEvent* x)
+}
+
+declare 53 win {
+ void XPutBackEvent (Display* d, XEvent* x)
+}
+
+declare 54 win {
+ void XQueryColors (Display* d, Colormap c, XColor* x, int i)
+}
+
+declare 55 win {
+ Bool XQueryPointer (Display* d, Window w1, Window* w2, Window* w3, \
+ int* i1, int* i2, int* i3, int* i4, unsigned int* ui)
+}
+
+declare 56 win {
+ Status XQueryTree (Display* d, Window w1, Window* w2, Window* w3, \
+ Window** w4, unsigned int* ui)
+}
+
+declare 57 win {
+ void XRaiseWindow (Display* d, Window w)
+}
+
+declare 58 win {
+ void XRefreshKeyboardMapping (XMappingEvent* x)
+}
+
+declare 59 win {
+ void XResizeWindow (Display* d, Window w, unsigned int ui1, \
+ unsigned int ui2)
+}
+
+declare 60 win {
+ void XSelectInput (Display* d, Window w, long l)
+}
+
+declare 61 win {
+ Status XSendEvent (Display* d, Window w, Bool b, long l, XEvent* x)
+}
+
+declare 62 win {
+ void XSetCommand (Display* d, Window w, char** c, int i)
+}
+
+declare 63 win {
+ void XSetIconName (Display* d, Window w, _Xconst char* c)
+}
+
+declare 64 win {
+ void XSetInputFocus (Display* d, Window w, int i, Time t)
+}
+
+declare 65 win {
+ void XSetSelectionOwner (Display* d, Atom a, Window w, Time t)
+}
+
+declare 66 win {
+ void XSetWindowBackground (Display* d, Window w, unsigned long ul)
+}
+
+declare 67 win {
+ void XSetWindowBackgroundPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 68 win {
+ void XSetWindowBorder (Display* d, Window w, unsigned long ul)
+}
+
+declare 69 win {
+ void XSetWindowBorderPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 70 win {
+ void XSetWindowBorderWidth (Display* d, Window w, unsigned int ui)
+}
+
+declare 71 win {
+ void XSetWindowColormap (Display* d, Window w, Colormap c)
+}
+
+declare 72 win {
+ Bool XTranslateCoordinates (Display* d, Window w1, Window w2, int i1,\
+ int i2, int* i3, int* i4, Window* w3)
+}
+
+declare 73 win {
+ void XUngrabKeyboard (Display* d, Time t)
+}
+
+declare 74 win {
+ void XUngrabPointer (Display* d, Time t)
+}
+
+declare 75 win {
+ void XUnmapWindow (Display* d, Window w)
+}
+
+declare 76 win {
+ void XWindowEvent (Display* d, Window w, long l, XEvent* x)
+}
+
+declare 77 win {
+ void XDestroyIC (XIC x)
+}
+
+declare 78 win {
+ Bool XFilterEvent (XEvent* x, Window w)
+}
+
+declare 79 win {
+ int XmbLookupString (XIC xi, XKeyPressedEvent* xk, \
+ char* c, int i, KeySym* k, Status* s)
+}
+
+declare 80 win {
+ void TkPutImage (unsigned long *colors, \
+ int ncolors, Display* display, Drawable d, \
+ GC gc, XImage* image, int src_x, int src_y, \
+ int dest_x, int dest_y, unsigned int width, \
+ unsigned int height)
+}
+# This slot is reserved for use by the clipping rectangle patch:
+# declare 81 win {
+# XSetClipRectangles(Display *display, GC gc, int clip_x_origin, \
+# int clip_y_origin, XRectangle rectangles[], int n, int ordering)
+# }
+
+declare 82 win {
+ Status XParseColor (Display *display, Colormap map, \
+ _Xconst char* spec, XColor *colorPtr)
+}
+
+declare 83 win {
+ GC XCreateGC(Display* display, Drawable d, \
+ unsigned long valuemask, XGCValues* values)
+}
+
+declare 84 win {
+ void XFreeGC(Display* display, GC gc)
+}
+
+declare 85 win {
+ Atom XInternAtom(Display* display,_Xconst char* atom_name, \
+ Bool only_if_exists)
+}
+
+declare 86 win {
+ void XSetBackground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 87 win {
+ void XSetForeground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 88 win {
+ void XSetClipMask(Display* display, GC gc, Pixmap pixmap)
+}
+
+declare 89 win {
+ void XSetClipOrigin(Display* display, GC gc, \
+ int clip_x_origin, int clip_y_origin)
+}
+
+declare 90 win {
+ void XSetTSOrigin(Display* display, GC gc, \
+ int ts_x_origin, int ts_y_origin)
+}
+
+declare 91 win {
+ void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values)
+}
+
+declare 92 win {
+ void XSetFont(Display *display, GC gc, Font font)
+}
+
+declare 93 win {
+ void XSetArcMode(Display *display, GC gc, int arc_mode)
+}
+
+declare 94 win {
+ void XSetStipple(Display *display, GC gc, Pixmap stipple)
+}
+
+declare 95 win {
+ void XSetFillRule(Display *display, GC gc, int fill_rule)
+}
+
+declare 96 win {
+ void XSetFillStyle(Display *display, GC gc, int fill_style)
+}
+
+declare 97 win {
+ void XSetFunction(Display *display, GC gc, int function)
+}
+
+declare 98 win {
+ void XSetLineAttributes(Display *display, GC gc, \
+ unsigned int line_width, int line_style, \
+ int cap_style, int join_style)
+}
+
+declare 99 win {
+ int _XInitImageFuncPtrs(XImage *image)
+}
+
+declare 100 win {
+ XIC XCreateIC(void)
+}
+
+declare 101 win {
+ XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \
+ XVisualInfo* vinfo_template, int* nitems_return)
+}
+
+declare 102 win {
+ void XSetWMClientMachine(Display* display, Window w, XTextProperty* text_prop)
+}
+
+declare 103 win {
+ Status XStringListToTextProperty(char** list, int count, \
+ XTextProperty* text_prop_return)
+}
+
+# X functions for Mac
+
+# This slot is reserved for use by the dash patch:
+# declare 0 win {
+# XSetDashes
+# }
+
+declare 1 mac {
+ XModifierKeymap* XGetModifierMapping (Display* d)
+}
+
+declare 2 mac {
+ XImage * XCreateImage (Display* d, Visual* v, unsigned int ui1, int i1, \
+ int i2, char* cp, unsigned int ui2, unsigned int ui3, int i3, \
+ int i4)
+
+}
+
+declare 3 mac {
+ XImage *XGetImage (Display* d, Drawable dr, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, unsigned long ul, int i3)
+}
+
+declare 4 mac {
+ char *XGetAtomName (Display* d,Atom a)
+
+}
+
+declare 5 mac {
+ char *XKeysymToString (KeySym k)
+}
+
+declare 6 mac {
+ Colormap XCreateColormap (Display* d, Window w, Visual* v, int i)
+
+}
+
+declare 7 mac {
+ GContext XGContextFromGC (GC g)
+}
+
+declare 8 mac {
+ KeySym XKeycodeToKeysym (Display* d, KeyCode k, int i)
+}
+
+declare 9 mac {
+ KeySym XStringToKeysym (_Xconst char* c)
+}
+
+declare 10 mac {
+ Window XRootWindow (Display* d, int i)
+}
+
+declare 11 mac {
+ XErrorHandler XSetErrorHandler (XErrorHandler x)
+}
+
+declare 12 mac {
+ Status XAllocColor (Display* d, Colormap c, XColor* xp)
+}
+
+declare 13 mac {
+ void XBell (Display* d, int i)
+}
+
+declare 14 mac {
+ void XChangeProperty (Display* d, Window w, Atom a, Atom a, int i1, \
+ int i2, _Xconst unsigned char* c, int i3)
+}
+
+declare 15 mac {
+ void XChangeWindowAttributes (Display* d, Window w, unsigned long ul, \
+ XSetWindowAttributes* x)
+}
+
+declare 16 mac {
+ void XConfigureWindow (Display* d, Window w, unsigned int i, \
+ XWindowChanges* x)
+}
+
+declare 17 mac {
+ void XCopyArea (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4)
+}
+
+declare 18 mac {
+ void XCopyPlane (Display* d, Drawable dr1, Drawable dr2, GC g, int i1, \
+ int i2, unsigned int ui1, \
+ unsigned int ui2, int i3, int i4, unsigned long ul)
+}
+
+declare 19 mac {
+ Pixmap XCreateBitmapFromData(Display* display, Drawable d, \
+ _Xconst char* data, unsigned int width,unsigned int height)
+}
+
+declare 20 mac {
+ void XDefineCursor (Display* d, Window w, Cursor c)
+}
+
+declare 21 mac {
+ void XDestroyWindow (Display* d, Window w)
+}
+
+declare 22 mac {
+ void XDrawArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 23 mac {
+ void XDrawLines (Display* d, Drawable dr, GC g, XPoint* x, int i1, int i2)
+}
+
+declare 24 mac {
+ void XDrawRectangle (Display* d, Drawable dr, GC g, int i1, int i2,\
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 25 mac {
+ void XFillArc (Display* d, Drawable dr, GC g, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2, int i3, int i4)
+}
+
+declare 26 mac {
+ void XFillPolygon (Display* d, Drawable dr, GC g, XPoint* x, \
+ int i1, int i2, int i3)
+}
+
+declare 27 mac {
+ void XFillRectangles (Display* d, Drawable dr, GC g, XRectangle* x, int i)
+}
+
+declare 28 mac {
+ void XFreeColormap (Display* d, Colormap c)
+}
+
+declare 29 mac {
+ void XFreeColors (Display* d, Colormap c, \
+ unsigned long* ulp, int i, unsigned long ul)
+}
+
+declare 30 mac {
+ void XFreeModifiermap (XModifierKeymap* x)
+}
+
+declare 31 mac {
+ Status XGetGeometry (Display* d, Drawable dr, Window* w, int* i1, \
+ int* i2, unsigned int* ui1, unsigned int* ui2, unsigned int* ui3, \
+ unsigned int* ui4)
+}
+
+declare 32 mac {
+ int XGetWindowProperty (Display* d, Window w, Atom a1, long l1, long l2, \
+ Bool b, Atom a2, Atom* ap, int* ip, unsigned long* ulp1, \
+ unsigned long* ulp2, unsigned char** cpp)
+}
+
+declare 33 mac {
+ int XGrabKeyboard (Display* d, Window w, Bool b, int i1, int i2, Time t)
+}
+
+declare 34 mac {
+ int XGrabPointer (Display* d, Window w1, Bool b, unsigned int ui, \
+ int i1, int i2, Window w2, Cursor c, Time t)
+}
+
+declare 35 mac {
+ KeyCode XKeysymToKeycode (Display* d, KeySym k)
+}
+
+declare 36 mac {
+ void XMapWindow (Display* d, Window w)
+}
+
+declare 37 mac {
+ void XMoveResizeWindow (Display* d, Window w, int i1, int i2, \
+ unsigned int ui1, unsigned int ui2)
+}
+
+declare 38 mac {
+ void XMoveWindow (Display* d, Window w, int i1, int i2)
+}
+
+declare 39 mac {
+ Bool XQueryPointer (Display* d, Window w1, Window* w2, Window* w3, \
+ int* i1, int* i2, int* i3, int* i4, unsigned int* ui)
+}
+
+declare 40 mac {
+ void XRaiseWindow (Display* d, Window w)
+}
+
+declare 41 mac {
+ void XRefreshKeyboardMapping (XMappingEvent* x)
+}
+
+declare 42 mac {
+ void XResizeWindow (Display* d, Window w, unsigned int ui1, \
+ unsigned int ui2)
+}
+
+declare 43 mac {
+ void XSelectInput (Display* d, Window w, long l)
+}
+
+declare 44 mac {
+ Status XSendEvent (Display* d, Window w, Bool b, long l, XEvent* x)
+}
+
+declare 45 mac {
+ void XSetIconName (Display* d, Window w, _Xconst char* c)
+}
+
+declare 46 mac {
+ void XSetInputFocus (Display* d, Window w, int i, Time t)
+}
+
+declare 47 mac {
+ void XSetSelectionOwner (Display* d, Atom a, Window w, Time t)
+}
+
+declare 48 mac {
+ void XSetWindowBackground (Display* d, Window w, unsigned long ul)
+}
+
+declare 49 mac {
+ void XSetWindowBackgroundPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 50 mac {
+ void XSetWindowBorder (Display* d, Window w, unsigned long ul)
+}
+
+declare 51 mac {
+ void XSetWindowBorderPixmap (Display* d, Window w, Pixmap p)
+}
+
+declare 52 mac {
+ void XSetWindowBorderWidth (Display* d, Window w, unsigned int ui)
+}
+
+declare 53 mac {
+ void XSetWindowColormap (Display* d, Window w, Colormap c)
+}
+
+declare 54 mac {
+ void XUngrabKeyboard (Display* d, Time t)
+}
+
+declare 55 mac {
+ void XUngrabPointer (Display* d, Time t)
+}
+
+declare 56 mac {
+ void XUnmapWindow (Display* d, Window w)
+}
+
+declare 57 mac {
+ void TkPutImage (unsigned long *colors, \
+ int ncolors, Display* display, Drawable d, \
+ GC gc, XImage* image, int src_x, int src_y, \
+ int dest_x, int dest_y, unsigned int width, \
+ unsigned int height)
+}
+declare 58 mac {
+ Status XParseColor (Display *display, Colormap map, \
+ _Xconst char* spec, XColor *colorPtr)
+}
+
+declare 59 mac {
+ GC XCreateGC(Display* display, Drawable d, \
+ unsigned long valuemask, XGCValues* values)
+}
+
+declare 60 mac {
+ void XFreeGC(Display* display, GC gc)
+}
+
+declare 61 mac {
+ Atom XInternAtom(Display* display,_Xconst char* atom_name, \
+ Bool only_if_exists)
+}
+
+declare 62 mac {
+ void XSetBackground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 63 mac {
+ void XSetForeground(Display* display, GC gc, \
+ unsigned long foreground)
+}
+
+declare 64 mac {
+ void XSetClipMask(Display* display, GC gc, Pixmap pixmap)
+}
+
+declare 65 mac {
+ void XSetClipOrigin(Display* display, GC gc, \
+ int clip_x_origin, int clip_y_origin)
+}
+
+declare 66 mac {
+ void XSetTSOrigin(Display* display, GC gc, \
+ int ts_x_origin, int ts_y_origin)
+}
+
+declare 67 mac {
+ void XChangeGC(Display * d, GC gc, unsigned long mask, XGCValues *values)
+}
+
+declare 68 mac {
+ void XSetFont(Display *display, GC gc, Font font)
+}
+
+declare 69 mac {
+ void XSetArcMode(Display *display, GC gc, int arc_mode)
+}
+
+declare 70 mac {
+ void XSetStipple(Display *display, GC gc, Pixmap stipple)
+}
+
+declare 71 mac {
+ void XSetFillRule(Display *display, GC gc, int fill_rule)
+}
+
+declare 72 mac {
+ void XSetFillStyle(Display *display, GC gc, int fill_style)
+}
+
+declare 73 mac {
+ void XSetFunction(Display *display, GC gc, int function)
+}
+
+declare 74 mac {
+ void XSetLineAttributes(Display *display, GC gc, \
+ unsigned int line_width, int line_style, \
+ int cap_style, int join_style)
+}
+
+declare 75 mac {
+ int _XInitImageFuncPtrs(XImage *image)
+}
+
+declare 76 mac {
+ XIC XCreateIC(void)
+}
+
+declare 77 mac {
+ XVisualInfo *XGetVisualInfo(Display* display, long vinfo_mask, \
+ XVisualInfo* vinfo_template, int* nitems_return)
+}
+
+declare 78 mac {
+ void XSetWMClientMachine(Display* display, Window w, \
+ XTextProperty* text_prop)
+}
+
+declare 79 mac {
+ Status XStringListToTextProperty(char** list, int count, \
+ XTextProperty* text_prop_return)
+}
+declare 80 mac {
+ void XDrawSegments(Display *display, Drawable d, GC gc, \
+ XSegment *segments, int nsegments)
+}
+declare 81 mac {
+ void XForceScreenSaver(Display* display, int mode)
+}
+
diff --git a/tk/generic/tkInt.h b/tk/generic/tkInt.h
index 359b6c99150..1164edd4b1c 100644
--- a/tk/generic/tkInt.h
+++ b/tk/generic/tkInt.h
@@ -27,18 +27,12 @@
#include <tkPort.h>
#endif
-#ifdef BUILD_tk
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-
/*
* Opaque type declarations:
*/
typedef struct TkColormap TkColormap;
typedef struct TkGrabEvent TkGrabEvent;
-typedef struct Tk_PostscriptInfo Tk_PostscriptInfo;
typedef struct TkpCursor_ *TkpCursor;
typedef struct TkRegion_ *TkRegion;
typedef struct TkStressedCmap TkStressedCmap;
@@ -87,16 +81,37 @@ typedef struct TkClassProcs {
typedef struct TkCursor {
Tk_Cursor cursor; /* System specific identifier for cursor. */
- int refCount; /* Number of active uses of 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;
/*
* One of the following structures is maintained for each display
- * containing a window managed by Tk:
+ * 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 {
@@ -108,6 +123,23 @@ typedef struct TkDisplay {
* 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:
*/
@@ -133,6 +165,63 @@ typedef struct TkDisplay {
* 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:
*/
@@ -146,68 +235,65 @@ typedef struct TkDisplay {
* gets big, handlers get cleaned up. */
/*
- * Information used by tkSend.c only:
+ * Used by tkEvent.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. */
+ 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 tkSelect.c and tkClipboard.c only:
+ * Information used by tkFocus.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. */
+ 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. */
- 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 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 tkAtom.c only:
+ * Information used by tkGeometry.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. */
+ 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 tkCursor.c only:
+ * Information used by tkGet.c only:
*/
-
- Font cursorFont; /* Font to use for standard cursors.
- * None means font not loaded yet. */
+
+ Tcl_HashTable uidTable; /* Stores all Tk_Uid used in a thread. */
+ int uidInit; /* 0 means uidTable needs initializing. */
/*
* Information used by tkGrab.c only:
@@ -245,6 +331,100 @@ typedef struct TkDisplay {
* in tkGrab.c. */
/*
+ * Information used by tkGrid.c only:
+ */
+
+ int gridInit; /* 0 means table below needs initializing. */
+ Tcl_HashTable gridHashTable;/* Maps from Tk_Window tokens to
+ * corresponding Grid structures. */
+
+ /*
+ * Information used by tkImage.c only:
+ */
+
+ int imageId; /* Value used to number image ids. */
+
+ /*
+ * Information used by tkMacWinMenu.c only:
+ */
+
+ int postCommandGeneration;
+
+ /*
+ * Information used by tkOption.c only.
+ */
+
+
+
+ /*
+ * Information used by tkPack.c only.
+ */
+
+ int packInit; /* 0 means table below needs initializing. */
+ Tcl_HashTable packerHashTable;
+ /* Maps from Tk_Window tokens to
+ * corresponding Packer structures. */
+
+
+ /*
+ * Information used by tkPlace.c only.
+ */
+
+ int placeInit; /* 0 means tables below need initializing. */
+ Tcl_HashTable masterTable; /* Maps from Tk_Window toke to the Master
+ * structure for the window, if it exists. */
+ Tcl_HashTable slaveTable; /* Maps from Tk_Window toke to the Slave
+ * structure for the window, if it exists. */
+
+ /*
+ * Information used by tkSelect.c and tkClipboard.c only:
+ */
+
+ struct TkSelectionInfo *selectionInfoPtr;
+ /* First in list of selection information
+ * records. Each entry contains information
+ * about the current owner of a particular
+ * selection on this display. */
+ Atom multipleAtom; /* Atom for MULTIPLE. None means
+ * selection stuff isn't initialized. */
+ Atom incrAtom; /* Atom for INCR. */
+ Atom targetsAtom; /* Atom for TARGETS. */
+ Atom timestampAtom; /* Atom for TIMESTAMP. */
+ Atom textAtom; /* Atom for TEXT. */
+ Atom compoundTextAtom; /* Atom for COMPOUND_TEXT. */
+ Atom applicationAtom; /* Atom for TK_APPLICATION. */
+ Atom windowAtom; /* Atom for TK_WINDOW. */
+ Atom clipboardAtom; /* Atom for CLIPBOARD. */
+
+ Tk_Window clipWindow; /* Window used for clipboard ownership and to
+ * retrieve selections between processes. NULL
+ * means clipboard info hasn't been
+ * initialized. */
+ int clipboardActive; /* 1 means we currently own the clipboard
+ * selection, 0 means we don't. */
+ struct TkMainInfo *clipboardAppPtr;
+ /* Last application that owned clipboard. */
+ struct TkClipboardTarget *clipTargetPtr;
+ /* First in list of clipboard type information
+ * records. Each entry contains information
+ * about the buffers for a given selection
+ * target. */
+
+ /*
+ * Information used by tkSend.c only:
+ */
+
+ Tk_Window commTkwin; /* Window used for communication
+ * between interpreters during "send"
+ * commands. NULL means send info hasn't
+ * been initialized yet. */
+ Atom commProperty; /* X's name for comm property. */
+ Atom registryProperty; /* X's name for property containing
+ * registry of interpreter names. */
+ Atom appNameProperty; /* X's name for property used to hold the
+ * application name on each comm window. */
+
+ /*
* Information used by tkXId.c only:
*/
@@ -263,6 +443,19 @@ typedef struct TkDisplay {
* hasn't. */
/*
+ * Information used by tkUnixWm.c and tkWinWm.c only:
+ */
+
+ int wmTracing; /* Used to enable or disable tracing in
+ * this module. If tracing is enabled,
+ * then information is printed on
+ * standard output about interesting
+ * interactions with the window manager. */
+ struct TkWmInfo *firstWmPtr; /* Points to first top-level window. */
+ struct TkWmInfo *foregroundWmPtr;
+ /* Points to the foreground window. */
+
+ /*
* Information maintained by tkWindow.c for use later on by tkXId.c:
*/
@@ -283,46 +476,6 @@ typedef struct TkDisplay {
* allocated for this display. */
/*
- * Information used by tkFocus.c only:
- */
-
- struct TkWindow *implicitWinPtr;
- /* If the focus arrived at a toplevel window
- * implicitly via an Enter event (rather
- * than via a FocusIn event), this points
- * to the toplevel window. Otherwise it is
- * NULL. */
- struct TkWindow *focusPtr; /* Points to the window on this display that
- * should be receiving keyboard events. When
- * multiple applications on the display have
- * the focus, this will refer to the
- * innermost window in the innermost
- * application. This information isn't used
- * under Unix or Windows, but it's needed on
- * the Macintosh. */
-
- /*
- * Used by tkColor.c only:
- */
-
- TkStressedCmap *stressPtr; /* First in list of colormaps that have
- * filled up, so we have to pick an
- * approximate color. */
-
- /*
- * Used by tkEvent.c only:
- */
-
- struct TkWindowEvent *delayedMotionPtr;
- /* Points to a malloc-ed motion event
- * whose processing has been delayed in
- * the hopes that another motion event
- * will come along right away and we can
- * merge the two of them together. NULL
- * means that there is no delayed motion
- * event. */
-
- /*
* Miscellaneous information:
*/
@@ -336,6 +489,16 @@ typedef struct TkDisplay {
* 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 */
+ int warpInProgress;
+ Window warpWindow;
+ int warpX;
+ int warpY;
+ int useInputMethods; /* Whether to use input methods */
} TkDisplay;
/*
@@ -373,6 +536,9 @@ typedef struct TkErrorHandler {
* list. */
} TkErrorHandler;
+
+
+
/*
* One of the following structures exists for each event handler
* created by calling Tk_CreateEventHandler. This information
@@ -393,7 +559,7 @@ typedef struct TkEventHandler {
/*
* Tk keeps one of the following data structures for each main
- * window (created by a call to Tk_CreateMainWindow). It stores
+ * window (created by a call to TkCreateMainWindow). It stores
* information that is shared by all of the windows associated
* with a particular main window.
*/
@@ -415,10 +581,10 @@ typedef struct TkMainInfo {
/* Used in conjunction with "bind" command
* to bind events to Tcl commands. */
TkBindInfo bindInfo; /* Information used by tkBind.c on a per
- * interpreter basis. */
+ * application basis. */
struct TkFontInfo *fontInfoPtr;
- /* Hold named font tables. Used only by
- * tkFont.c. */
+ /* Information used by tkFont.c on a per
+ * application basis. */
/*
* Information used only by tkFocus.c and tk*Embed.c:
@@ -685,296 +851,239 @@ extern TkDisplay *tkDisplayList;
#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)
+
+/*
* Miscellaneous variables shared among Tk modules but not exported
* to the outside world:
*/
-extern Tk_Uid tkActiveUid;
+extern Tk_SmoothMethod tkBezierSmoothMethod;
extern Tk_ImageType tkBitmapImageType;
-extern Tk_Uid tkDisabledUid;
extern Tk_PhotoImageFormat tkImgFmtGIF;
extern void (*tkHandleEventProc) _ANSI_ARGS_((
XEvent* eventPtr));
extern Tk_PhotoImageFormat tkImgFmtPPM;
extern TkMainInfo *tkMainWindowList;
-extern Tk_Uid tkNormalUid;
extern Tk_ImageType tkPhotoImageType;
extern Tcl_HashTable tkPredefBitmapTable;
extern int tkSendSerial;
+#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 char * TkAlignImageData _ANSI_ARGS_((XImage *image,
- int alignment, int bitOrder));
-EXTERN TkWindow * TkAllocWindow _ANSI_ARGS_((TkDisplay *dispPtr,
- int screenNum, TkWindow *parentPtr));
-EXTERN void TkBezierPoints _ANSI_ARGS_((double control[],
- int numSteps, double *coordPtr));
-EXTERN void TkBezierScreenPoints _ANSI_ARGS_((Tk_Canvas canvas,
- double control[], int numSteps,
- XPoint *xPointPtr));
-EXTERN void TkBindDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkBindEventProc _ANSI_ARGS_((TkWindow *winPtr,
- XEvent *eventPtr));
-EXTERN void TkBindFree _ANSI_ARGS_((TkMainInfo *mainPtr));
-EXTERN void TkBindInit _ANSI_ARGS_((TkMainInfo *mainPtr));
-EXTERN void TkChangeEventWindow _ANSI_ARGS_((XEvent *eventPtr,
- TkWindow *winPtr));
-#ifndef TkClipBox
-EXTERN void TkClipBox _ANSI_ARGS_((TkRegion rgn,
- XRectangle* rect_return));
-#endif
-EXTERN int TkClipInit _ANSI_ARGS_((Tcl_Interp *interp,
- TkDisplay *dispPtr));
-EXTERN void TkComputeAnchor _ANSI_ARGS_((Tk_Anchor anchor,
- Tk_Window tkwin, int padX, int padY,
- int innerWidth, int innerHeight, int *xPtr,
- int *yPtr));
-EXTERN int TkCopyAndGlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
- char *script));
-EXTERN unsigned long TkCreateBindingProcedure _ANSI_ARGS_((
- Tcl_Interp *interp, Tk_BindingTable bindingTable,
- ClientData object, char *eventString,
- TkBindEvalProc *evalProc, TkBindFreeProc *freeProc,
- ClientData clientData));
-EXTERN TkCursor * TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin,
- char *source, char *mask, int width, int height,
- int xHot, int yHot, XColor fg, XColor bg));
-EXTERN int TkCreateFrame _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv,
- int toplevel, char *appName));
-EXTERN Tk_Window TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp *interp,
- char *screenName, char *baseName));
-#ifndef TkCreateRegion
-EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
-#endif
-EXTERN Time TkCurrentTime _ANSI_ARGS_((TkDisplay *dispPtr));
+EXTERN int Tk_AfterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_BellObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_BindCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_BindtagsCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ButtonObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_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_ClipboardCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_ChooseColorObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ChooseDirectoryObjCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Tk_ChooseFontObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_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_GrabCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_GridCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_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_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_MessageCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_OptionObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_PackCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_PlaceCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_RadiobuttonObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_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, char **argv));
+EXTERN int Tk_SelectionCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_SendCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_TextCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_TkObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN int Tk_TkwaitCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tk_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_WmCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
+ int devId, char *buffer, long size));
+
+EXTERN void TkEventInit _ANSI_ARGS_((void));
+
+EXTERN int TkCreateMenuCmd _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TkDeadAppCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
-EXTERN void TkDeleteAllImages _ANSI_ARGS_((TkMainInfo *mainPtr));
-#ifndef TkDestroyRegion
-EXTERN void TkDestroyRegion _ANSI_ARGS_((TkRegion rgn));
-#endif
-EXTERN void TkDoConfigureNotify _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkDrawInsetFocusHighlight _ANSI_ARGS_((
- Tk_Window tkwin, GC gc, int width,
- Drawable drawable, int padding));
-EXTERN void TkEventDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas,
- double *coordPtr, int numPoints, Display *display,
- Drawable drawable, GC gc, GC outlineGC));
-EXTERN int TkFindStateNum _ANSI_ARGS_((Tcl_Interp *interp,
- CONST char *option, CONST TkStateMap *mapPtr,
- CONST char *strKey));
-EXTERN char * TkFindStateString _ANSI_ARGS_((
- CONST TkStateMap *mapPtr, int numKey));
-EXTERN void TkFocusDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkFocusFilterEvent _ANSI_ARGS_((TkWindow *winPtr,
- XEvent *eventPtr));
-EXTERN TkWindow * TkFocusKeyEvent _ANSI_ARGS_((TkWindow *winPtr,
- XEvent *eventPtr));
-EXTERN void TkFontPkgInit _ANSI_ARGS_((TkMainInfo *mainPtr));
-EXTERN void TkFontPkgFree _ANSI_ARGS_((TkMainInfo *mainPtr));
-EXTERN void TkFreeBindingTags _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkFreeCursor _ANSI_ARGS_((TkCursor *cursorPtr));
-EXTERN void TkFreeWindowId _ANSI_ARGS_((TkDisplay *dispPtr,
- Window w));
-EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
- TkWindow *winPtr, int active));
-EXTERN char * TkGetBitmapData _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *fileName, int *widthPtr,
- int *heightPtr, int *hotXPtr, int *hotYPtr));
-EXTERN void TkGetButtPoints _ANSI_ARGS_((double p1[], double p2[],
- double width, int project, double m1[],
- double m2[]));
-EXTERN TkCursor * TkGetCursorByName _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, Tk_Uid string));
-EXTERN char * TkGetDefaultScreenName _ANSI_ARGS_((Tcl_Interp *interp,
- char *screenName));
-EXTERN TkDisplay * TkGetDisplay _ANSI_ARGS_((Display *display));
-EXTERN int TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[],
- Tk_Window *tkwinPtr));
-EXTERN TkWindow * TkGetFocusWin _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkGetInterpNames _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin));
-EXTERN int TkGetMiterPoints _ANSI_ARGS_((double p1[], double p2[],
- double p3[], double width, double m1[],
- double m2[]));
-EXTERN void TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin,
- int *xPtr, int *yPtr));
-EXTERN int TkGetProlog _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void TkGetServerInfo _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin));
-EXTERN void TkGrabDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkGrabState _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkIncludePoint _ANSI_ARGS_((Tk_Item *itemPtr,
- double *pointPtr));
-EXTERN void TkInitXId _ANSI_ARGS_((TkDisplay *dispPtr));
-EXTERN void TkInOutEvents _ANSI_ARGS_((XEvent *eventPtr,
- TkWindow *sourcePtr, TkWindow *destPtr,
- int leaveType, int enterType,
- Tcl_QueuePosition position));
-EXTERN void TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin));
-#ifndef TkIntersectRegion
-EXTERN void TkIntersectRegion _ANSI_ARGS_((TkRegion sra,
- TkRegion srcb, TkRegion dr_return));
-#endif
-EXTERN char * TkKeysymToString _ANSI_ARGS_((KeySym keysym));
-EXTERN int TkLineToArea _ANSI_ARGS_((double end1Ptr[2],
- double end2Ptr[2], double rectPtr[4]));
-EXTERN double TkLineToPoint _ANSI_ARGS_((double end1Ptr[2],
- double end2Ptr[2], double pointPtr[2]));
-EXTERN int TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas,
- double *pointPtr, int numPoints, int numSteps,
- XPoint xPoints[], double dblPoints[]));
-EXTERN void TkMakeBezierPostscript _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Canvas canvas, double *pointPtr,
- int numPoints));
-EXTERN void TkOptionClassChanged _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkOvalToArea _ANSI_ARGS_((double *ovalPtr,
- double *rectPtr));
-EXTERN double TkOvalToPoint _ANSI_ARGS_((double ovalPtr[4],
- double width, int filled, double pointPtr[2]));
-EXTERN int TkpChangeFocus _ANSI_ARGS_((TkWindow *winPtr,
- int force));
-EXTERN void TkpCloseDisplay _ANSI_ARGS_((TkDisplay *dispPtr));
-EXTERN void TkpClaimFocus _ANSI_ARGS_((TkWindow *topLevelPtr,
- int force));
-#ifndef TkpCmapStressed
-EXTERN int TkpCmapStressed _ANSI_ARGS_((Tk_Window tkwin,
- Colormap colormap));
-#endif
-#ifndef TkpCreateNativeBitmap
-EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display *display,
- char * source));
-#endif
-#ifndef TkpDefineNativeBitmaps
-EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void));
-#endif
-EXTERN void TkpDisplayWarning _ANSI_ARGS_((char *msg,
- char *title));
-EXTERN void TkpGetAppName _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_DString *name));
-EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
-#ifndef TkpGetNativeAppBitmap
-EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display *display,
- char *name, int *width, int *height));
-#endif
-EXTERN TkWindow * TkpGetOtherWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN TkWindow * TkpGetWrapperWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkpInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void TkpInitializeMenuBindings _ANSI_ARGS_((
- Tcl_Interp *interp, Tk_BindingTable bindingTable));
-EXTERN void TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin,
- int transient));
-EXTERN Window TkpMakeWindow _ANSI_ARGS_((TkWindow *winPtr,
- Window parent));
-EXTERN void TkpMenuNotifyToplevelCreate _ANSI_ARGS_((
- Tcl_Interp *, char *menuName));
-EXTERN TkDisplay * TkpOpenDisplay _ANSI_ARGS_((char *display_name));
-EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkPointerEvent _ANSI_ARGS_((XEvent *eventPtr,
- TkWindow *winPtr));
-EXTERN int TkPolygonToArea _ANSI_ARGS_((double *polyPtr,
- int numPoints, double *rectPtr));
-EXTERN double TkPolygonToPoint _ANSI_ARGS_((double *polyPtr,
- int numPoints, double *pointPtr));
-EXTERN int TkPositionInTree _ANSI_ARGS_((TkWindow *winPtr,
- TkWindow *treePtr));
-#ifndef TkpPrintWindowId
-EXTERN void TkpPrintWindowId _ANSI_ARGS_((char *buf,
- Window window));
-#endif
-EXTERN void TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow *winPtr,
- XEvent *eventPtr));
-#ifndef TkpScanWindowId
-EXTERN int TkpScanWindowId _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *idPtr));
-#endif
-EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
-EXTERN void TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *menuName));
-#ifndef TkpSync
-EXTERN void TkpSync _ANSI_ARGS_((Display *display));
-#endif
+
EXTERN int TkpTestembedCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
-EXTERN int TkpUseWindow _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *string));
-#ifndef TkPutImage
-EXTERN void TkPutImage _ANSI_ARGS_((unsigned long *colors,
- int ncolors, Display* display, Drawable d,
- GC gc, XImage* image, int src_x, int src_y,
- int dest_x, int dest_y, unsigned int width,
- unsigned int height));
-#endif
-EXTERN int TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win,
- TkDisplay *dispPtr));
-EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow *winPtr,
- int state));
-EXTERN void TkQueueEventForAllChildren _ANSI_ARGS_((
- TkWindow *winPtr, XEvent *eventPtr));
-EXTERN int TkReadBitmapFile _ANSI_ARGS_((Display* display,
- Drawable d, CONST char* filename,
- unsigned int* width_return,
- unsigned int* height_return,
- Pixmap* bitmap_return,
- int* x_hot_return, int* y_hot_return));
-#ifndef TkRectInRegion
-EXTERN int TkRectInRegion _ANSI_ARGS_((TkRegion rgn,
- int x, int y, unsigned int width,
- unsigned int height));
-#endif
-EXTERN int TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc,
- int x, int y, int width, int height, int dx,
- int dy, TkRegion damageRgn));
-EXTERN void TkSelDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin,
- XEvent *eventPtr));
-EXTERN void TkSelInit _ANSI_ARGS_((Tk_Window tkwin));
-EXTERN void TkSelPropProc _ANSI_ARGS_((XEvent *eventPtr));
-EXTERN void TkSetClassProcs _ANSI_ARGS_((Tk_Window tkwin,
- TkClassProcs *procs, ClientData instanceData));
-#ifndef TkSetPixmapColormap
-EXTERN void TkSetPixmapColormap _ANSI_ARGS_((Pixmap pixmap,
- Colormap colormap));
-#endif
-#ifndef TkSetRegion
-EXTERN void TkSetRegion _ANSI_ARGS_((Display* display, GC gc,
- TkRegion rgn));
-#endif
-EXTERN void TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp *interp,
- Tk_Window tkwin, char *oldMenuName,
- char *menuName));
-EXTERN KeySym TkStringToKeysym _ANSI_ARGS_((char *name));
-EXTERN int TkThickPolyLineToArea _ANSI_ARGS_((double *coordPtr,
- int numPoints, double width, int capStyle,
- int joinStyle, double *rectPtr));
-#ifndef TkUnionRectWithRegion
-EXTERN void TkUnionRectWithRegion _ANSI_ARGS_((XRectangle* rect,
- TkRegion src, TkRegion dr_return));
-#endif
-EXTERN void TkWmAddToColormapWindows _ANSI_ARGS_((
- TkWindow *winPtr));
-EXTERN void TkWmDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN TkWindow * TkWmFocusToplevel _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkWmMapWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkWmNewWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkWmProtocolEventProc _ANSI_ARGS_((TkWindow *winPtr,
- XEvent *evenvPtr));
-EXTERN void TkWmRemoveFromColormapWindows _ANSI_ARGS_((
- TkWindow *winPtr));
-EXTERN void TkWmRestackToplevel _ANSI_ARGS_((TkWindow *winPtr,
- int aboveBelow, TkWindow *otherPtr));
-EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow *winPtr));
+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 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.
@@ -987,8 +1096,10 @@ EXTERN void TkRegisterColorGC _ANSI_ARGS_((XColor *, Display *,
GC, unsigned long));
EXTERN void TkDeregisterColorGC _ANSI_ARGS_((XColor *, GC,
unsigned long));
+
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
-
#endif /* _TKINT */
+
+
diff --git a/tk/generic/tkIntDecls.h b/tk/generic/tkIntDecls.h
new file mode 100644
index 00000000000..0e37d59f8b1
--- /dev/null
+++ b/tk/generic/tkIntDecls.h
@@ -0,0 +1,1485 @@
+/*
+ * 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, char * eventString,
+ TkBindEvalProc * evalProc,
+ TkBindFreeProc * freeProc,
+ ClientData clientData));
+/* 12 */
+EXTERN TkCursor * TkCreateCursorFromData _ANSI_ARGS_((Tk_Window tkwin,
+ char * source, char * mask, int width,
+ int height, int xHot, int yHot, XColor fg,
+ XColor bg));
+/* 13 */
+EXTERN int TkCreateFrame _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, int argc, char ** argv,
+ int toplevel, char * appName));
+/* 14 */
+EXTERN Tk_Window TkCreateMainWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ char * screenName, char * baseName));
+/* 15 */
+EXTERN Time TkCurrentTime _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 16 */
+EXTERN void TkDeleteAllImages _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 17 */
+EXTERN void TkDoConfigureNotify _ANSI_ARGS_((TkWindow * winPtr));
+/* 18 */
+EXTERN void TkDrawInsetFocusHighlight _ANSI_ARGS_((
+ Tk_Window tkwin, GC gc, int width,
+ Drawable drawable, int padding));
+/* 19 */
+EXTERN void TkEventDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 20 */
+EXTERN void TkFillPolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ double * coordPtr, int numPoints,
+ Display * display, Drawable drawable, GC gc,
+ GC outlineGC));
+/* 21 */
+EXTERN int TkFindStateNum _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * option,
+ CONST TkStateMap * mapPtr,
+ CONST char * strKey));
+/* 22 */
+EXTERN char * TkFindStateString _ANSI_ARGS_((
+ CONST TkStateMap * mapPtr, int numKey));
+/* 23 */
+EXTERN void TkFocusDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 24 */
+EXTERN int TkFocusFilterEvent _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 25 */
+EXTERN TkWindow * TkFocusKeyEvent _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 26 */
+EXTERN void TkFontPkgInit _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 27 */
+EXTERN void TkFontPkgFree _ANSI_ARGS_((TkMainInfo * mainPtr));
+/* 28 */
+EXTERN void TkFreeBindingTags _ANSI_ARGS_((TkWindow * winPtr));
+/* 29 */
+EXTERN void TkpFreeCursor _ANSI_ARGS_((TkCursor * cursorPtr));
+/* 30 */
+EXTERN char * TkGetBitmapData _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, char * fileName,
+ int * widthPtr, int * heightPtr,
+ int * hotXPtr, int * hotYPtr));
+/* 31 */
+EXTERN void TkGetButtPoints _ANSI_ARGS_((double p1[],
+ double p2[], double width, int project,
+ double m1[], double m2[]));
+/* 32 */
+EXTERN TkCursor * TkGetCursorByName _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Uid string));
+/* 33 */
+EXTERN char * TkGetDefaultScreenName _ANSI_ARGS_((
+ Tcl_Interp * interp, char * screenName));
+/* 34 */
+EXTERN TkDisplay * TkGetDisplay _ANSI_ARGS_((Display * display));
+/* 35 */
+EXTERN int TkGetDisplayOf _ANSI_ARGS_((Tcl_Interp * interp,
+ int objc, Tcl_Obj *CONST objv[],
+ Tk_Window * tkwinPtr));
+/* 36 */
+EXTERN TkWindow * TkGetFocusWin _ANSI_ARGS_((TkWindow * winPtr));
+/* 37 */
+EXTERN int TkGetInterpNames _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin));
+/* 38 */
+EXTERN int TkGetMiterPoints _ANSI_ARGS_((double p1[],
+ double p2[], double p3[], double width,
+ double m1[], double m2[]));
+/* 39 */
+EXTERN void TkGetPointerCoords _ANSI_ARGS_((Tk_Window tkwin,
+ int * xPtr, int * yPtr));
+/* 40 */
+EXTERN void TkGetServerInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin));
+/* 41 */
+EXTERN void TkGrabDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 42 */
+EXTERN int TkGrabState _ANSI_ARGS_((TkWindow * winPtr));
+/* 43 */
+EXTERN void TkIncludePoint _ANSI_ARGS_((Tk_Item * itemPtr,
+ double * pointPtr));
+/* 44 */
+EXTERN void TkInOutEvents _ANSI_ARGS_((XEvent * eventPtr,
+ TkWindow * sourcePtr, TkWindow * destPtr,
+ int leaveType, int enterType,
+ Tcl_QueuePosition position));
+/* 45 */
+EXTERN void TkInstallFrameMenu _ANSI_ARGS_((Tk_Window tkwin));
+/* 46 */
+EXTERN char * TkKeysymToString _ANSI_ARGS_((KeySym keysym));
+/* 47 */
+EXTERN int TkLineToArea _ANSI_ARGS_((double end1Ptr[],
+ double end2Ptr[], double rectPtr[]));
+/* 48 */
+EXTERN double TkLineToPoint _ANSI_ARGS_((double end1Ptr[],
+ double end2Ptr[], double pointPtr[]));
+/* 49 */
+EXTERN int TkMakeBezierCurve _ANSI_ARGS_((Tk_Canvas canvas,
+ double * pointPtr, int numPoints,
+ int numSteps, XPoint xPoints[],
+ double dblPoints[]));
+/* 50 */
+EXTERN void TkMakeBezierPostscript _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Canvas canvas,
+ double * pointPtr, int numPoints));
+/* 51 */
+EXTERN void TkOptionClassChanged _ANSI_ARGS_((TkWindow * winPtr));
+/* 52 */
+EXTERN void TkOptionDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 53 */
+EXTERN int TkOvalToArea _ANSI_ARGS_((double * ovalPtr,
+ double * rectPtr));
+/* 54 */
+EXTERN double TkOvalToPoint _ANSI_ARGS_((double ovalPtr[],
+ double width, int filled, double pointPtr[]));
+/* 55 */
+EXTERN int TkpChangeFocus _ANSI_ARGS_((TkWindow * winPtr,
+ int force));
+/* 56 */
+EXTERN void TkpCloseDisplay _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 57 */
+EXTERN void TkpClaimFocus _ANSI_ARGS_((TkWindow * topLevelPtr,
+ int force));
+/* 58 */
+EXTERN void TkpDisplayWarning _ANSI_ARGS_((char * msg,
+ char * title));
+/* 59 */
+EXTERN void TkpGetAppName _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_DString * name));
+/* 60 */
+EXTERN TkWindow * TkpGetOtherWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 61 */
+EXTERN TkWindow * TkpGetWrapperWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 62 */
+EXTERN int TkpInit _ANSI_ARGS_((Tcl_Interp * interp));
+/* 63 */
+EXTERN void TkpInitializeMenuBindings _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ Tk_BindingTable bindingTable));
+/* 64 */
+EXTERN void TkpMakeContainer _ANSI_ARGS_((Tk_Window tkwin));
+/* 65 */
+EXTERN void TkpMakeMenuWindow _ANSI_ARGS_((Tk_Window tkwin,
+ int transient));
+/* 66 */
+EXTERN Window TkpMakeWindow _ANSI_ARGS_((TkWindow * winPtr,
+ Window parent));
+/* 67 */
+EXTERN void TkpMenuNotifyToplevelCreate _ANSI_ARGS_((
+ Tcl_Interp * interp1, char * menuName));
+/* 68 */
+EXTERN TkDisplay * TkpOpenDisplay _ANSI_ARGS_((char * display_name));
+/* 69 */
+EXTERN int TkPointerEvent _ANSI_ARGS_((XEvent * eventPtr,
+ TkWindow * winPtr));
+/* 70 */
+EXTERN int TkPolygonToArea _ANSI_ARGS_((double * polyPtr,
+ int numPoints, double * rectPtr));
+/* 71 */
+EXTERN double TkPolygonToPoint _ANSI_ARGS_((double * polyPtr,
+ int numPoints, double * pointPtr));
+/* 72 */
+EXTERN int TkPositionInTree _ANSI_ARGS_((TkWindow * winPtr,
+ TkWindow * treePtr));
+/* 73 */
+EXTERN void TkpRedirectKeyEvent _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr));
+/* 74 */
+EXTERN void TkpSetMainMenubar _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * menuName));
+/* 75 */
+EXTERN int TkpUseWindow _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * string));
+/* 76 */
+EXTERN int TkpWindowWasRecentlyDeleted _ANSI_ARGS_((Window win,
+ TkDisplay * dispPtr));
+/* 77 */
+EXTERN void TkQueueEventForAllChildren _ANSI_ARGS_((
+ TkWindow * winPtr, XEvent * eventPtr));
+/* 78 */
+EXTERN int TkReadBitmapFile _ANSI_ARGS_((Display* display,
+ Drawable d, CONST char* filename,
+ unsigned int* width_return,
+ unsigned int* height_return,
+ Pixmap* bitmap_return, int* x_hot_return,
+ int* y_hot_return));
+/* 79 */
+EXTERN int TkScrollWindow _ANSI_ARGS_((Tk_Window tkwin, GC gc,
+ int x, int y, int width, int height, int dx,
+ int dy, TkRegion damageRgn));
+/* 80 */
+EXTERN void TkSelDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 81 */
+EXTERN void TkSelEventProc _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent * eventPtr));
+/* 82 */
+EXTERN void TkSelInit _ANSI_ARGS_((Tk_Window tkwin));
+/* 83 */
+EXTERN void TkSelPropProc _ANSI_ARGS_((XEvent * eventPtr));
+/* 84 */
+EXTERN void TkSetClassProcs _ANSI_ARGS_((Tk_Window tkwin,
+ TkClassProcs * procs,
+ ClientData instanceData));
+/* 85 */
+EXTERN void TkSetWindowMenuBar _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, char * oldMenuName,
+ char * menuName));
+/* 86 */
+EXTERN KeySym TkStringToKeysym _ANSI_ARGS_((char * name));
+/* 87 */
+EXTERN int TkThickPolyLineToArea _ANSI_ARGS_((double * coordPtr,
+ int numPoints, double width, int capStyle,
+ int joinStyle, double * rectPtr));
+/* 88 */
+EXTERN void TkWmAddToColormapWindows _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 89 */
+EXTERN void TkWmDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 90 */
+EXTERN TkWindow * TkWmFocusToplevel _ANSI_ARGS_((TkWindow * winPtr));
+/* 91 */
+EXTERN void TkWmMapWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 92 */
+EXTERN void TkWmNewWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 93 */
+EXTERN void TkWmProtocolEventProc _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * evenvPtr));
+/* 94 */
+EXTERN void TkWmRemoveFromColormapWindows _ANSI_ARGS_((
+ TkWindow * winPtr));
+/* 95 */
+EXTERN void TkWmRestackToplevel _ANSI_ARGS_((TkWindow * winPtr,
+ int aboveBelow, TkWindow * otherPtr));
+/* 96 */
+EXTERN void TkWmSetClass _ANSI_ARGS_((TkWindow * winPtr));
+/* 97 */
+EXTERN void TkWmUnmapWindow _ANSI_ARGS_((TkWindow * winPtr));
+/* 98 */
+EXTERN Tcl_Obj * TkDebugBitmap _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 99 */
+EXTERN Tcl_Obj * TkDebugBorder _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 100 */
+EXTERN Tcl_Obj * TkDebugCursor _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 101 */
+EXTERN Tcl_Obj * TkDebugColor _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 102 */
+EXTERN Tcl_Obj * TkDebugConfig _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_OptionTable table));
+/* 103 */
+EXTERN Tcl_Obj * TkDebugFont _ANSI_ARGS_((Tk_Window tkwin,
+ char * name));
+/* 104 */
+EXTERN int TkFindStateNumObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_Obj * optionPtr,
+ CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr));
+/* 105 */
+EXTERN Tcl_HashTable * TkGetBitmapPredefTable _ANSI_ARGS_((void));
+/* 106 */
+EXTERN TkDisplay * TkGetDisplayList _ANSI_ARGS_((void));
+/* 107 */
+EXTERN TkMainInfo * TkGetMainInfoList _ANSI_ARGS_((void));
+/* 108 */
+EXTERN int TkGetWindowFromObj _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tcl_Obj * objPtr,
+ Tk_Window * windowPtr));
+/* 109 */
+EXTERN char * TkpGetString _ANSI_ARGS_((TkWindow * winPtr,
+ XEvent * eventPtr, Tcl_DString * dsPtr));
+/* 110 */
+EXTERN void TkpGetSubFonts _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Font tkfont));
+/* 111 */
+EXTERN Tcl_Obj * TkpGetSystemDefault _ANSI_ARGS_((Tk_Window tkwin,
+ char * dbName, char * className));
+/* 112 */
+EXTERN void TkpMenuThreadInit _ANSI_ARGS_((void));
+#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 __WIN32__
+/* 114 */
+EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 114 */
+EXTERN TkRegion TkCreateRegion _ANSI_ARGS_((void));
+#endif /* MAC_TCL */
+#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 __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 __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 __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 __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_TCL
+/* 120 */
+EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
+ TkWindow * winPtr, int active));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 121 */
+EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display * display,
+ char * source));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 122 */
+EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 123 */
+EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 124 */
+EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display * display,
+ CONST char * name, int * width, int * height));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 125 */
+EXTERN void TkPointerDeadWindow _ANSI_ARGS_((TkWindow * winPtr));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 126 */
+EXTERN void TkpSetCapture _ANSI_ARGS_((TkWindow * winPtr));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 127 */
+EXTERN void TkpSetCursor _ANSI_ARGS_((TkpCursor cursor));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 128 */
+EXTERN void TkpWmSetState _ANSI_ARGS_((TkWindow * winPtr,
+ int state));
+#endif /* MAC_TCL */
+/* Slot 129 is reserved */
+#ifdef MAC_TCL
+/* 130 */
+EXTERN Window TkGetTransientMaster _ANSI_ARGS_((TkWindow * winPtr));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 131 */
+EXTERN int TkGenerateButtonEvent _ANSI_ARGS_((int x, int y,
+ Window window, unsigned int state));
+#endif /* MAC_TCL */
+/* Slot 132 is reserved */
+#ifdef MAC_TCL
+/* 133 */
+EXTERN void TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+/* 134 */
+EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height,
+ int flags));
+#endif /* MAC_TCL */
+/* 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));
+
+typedef struct TkIntStubs {
+ int magic;
+ struct TkIntStubHooks *hooks;
+
+ TkWindow * (*tkAllocWindow) _ANSI_ARGS_((TkDisplay * dispPtr, int screenNum, TkWindow * parentPtr)); /* 0 */
+ void (*tkBezierPoints) _ANSI_ARGS_((double control[], int numSteps, double * coordPtr)); /* 1 */
+ void (*tkBezierScreenPoints) _ANSI_ARGS_((Tk_Canvas canvas, double control[], int numSteps, XPoint * xPointPtr)); /* 2 */
+ void (*tkBindDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 3 */
+ void (*tkBindEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 4 */
+ void (*tkBindFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 5 */
+ void (*tkBindInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 6 */
+ void (*tkChangeEventWindow) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 7 */
+ int (*tkClipInit) _ANSI_ARGS_((Tcl_Interp * interp, TkDisplay * dispPtr)); /* 8 */
+ void (*tkComputeAnchor) _ANSI_ARGS_((Tk_Anchor anchor, Tk_Window tkwin, int padX, int padY, int innerWidth, int innerHeight, int * xPtr, int * yPtr)); /* 9 */
+ int (*tkCopyAndGlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * script)); /* 10 */
+ unsigned long (*tkCreateBindingProcedure) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable, ClientData object, char * eventString, TkBindEvalProc * evalProc, TkBindFreeProc * freeProc, ClientData clientData)); /* 11 */
+ TkCursor * (*tkCreateCursorFromData) _ANSI_ARGS_((Tk_Window tkwin, char * source, char * mask, int width, int height, int xHot, int yHot, XColor fg, XColor bg)); /* 12 */
+ int (*tkCreateFrame) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv, int toplevel, char * appName)); /* 13 */
+ Tk_Window (*tkCreateMainWindow) _ANSI_ARGS_((Tcl_Interp * interp, char * screenName, char * baseName)); /* 14 */
+ Time (*tkCurrentTime) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 15 */
+ void (*tkDeleteAllImages) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 16 */
+ void (*tkDoConfigureNotify) _ANSI_ARGS_((TkWindow * winPtr)); /* 17 */
+ void (*tkDrawInsetFocusHighlight) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int width, Drawable drawable, int padding)); /* 18 */
+ void (*tkEventDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 19 */
+ void (*tkFillPolygon) _ANSI_ARGS_((Tk_Canvas canvas, double * coordPtr, int numPoints, Display * display, Drawable drawable, GC gc, GC outlineGC)); /* 20 */
+ int (*tkFindStateNum) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * option, CONST TkStateMap * mapPtr, CONST char * strKey)); /* 21 */
+ char * (*tkFindStateString) _ANSI_ARGS_((CONST TkStateMap * mapPtr, int numKey)); /* 22 */
+ void (*tkFocusDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 23 */
+ int (*tkFocusFilterEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 24 */
+ TkWindow * (*tkFocusKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 25 */
+ void (*tkFontPkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 26 */
+ void (*tkFontPkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 27 */
+ void (*tkFreeBindingTags) _ANSI_ARGS_((TkWindow * winPtr)); /* 28 */
+ void (*tkpFreeCursor) _ANSI_ARGS_((TkCursor * cursorPtr)); /* 29 */
+ char * (*tkGetBitmapData) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * fileName, int * widthPtr, int * heightPtr, int * hotXPtr, int * hotYPtr)); /* 30 */
+ void (*tkGetButtPoints) _ANSI_ARGS_((double p1[], double p2[], double width, int project, double m1[], double m2[])); /* 31 */
+ TkCursor * (*tkGetCursorByName) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tk_Uid string)); /* 32 */
+ char * (*tkGetDefaultScreenName) _ANSI_ARGS_((Tcl_Interp * interp, char * screenName)); /* 33 */
+ TkDisplay * (*tkGetDisplay) _ANSI_ARGS_((Display * display)); /* 34 */
+ int (*tkGetDisplayOf) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], Tk_Window * tkwinPtr)); /* 35 */
+ TkWindow * (*tkGetFocusWin) _ANSI_ARGS_((TkWindow * winPtr)); /* 36 */
+ int (*tkGetInterpNames) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 37 */
+ int (*tkGetMiterPoints) _ANSI_ARGS_((double p1[], double p2[], double p3[], double width, double m1[], double m2[])); /* 38 */
+ void (*tkGetPointerCoords) _ANSI_ARGS_((Tk_Window tkwin, int * xPtr, int * yPtr)); /* 39 */
+ void (*tkGetServerInfo) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin)); /* 40 */
+ void (*tkGrabDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 41 */
+ int (*tkGrabState) _ANSI_ARGS_((TkWindow * winPtr)); /* 42 */
+ void (*tkIncludePoint) _ANSI_ARGS_((Tk_Item * itemPtr, double * pointPtr)); /* 43 */
+ void (*tkInOutEvents) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * sourcePtr, TkWindow * destPtr, int leaveType, int enterType, Tcl_QueuePosition position)); /* 44 */
+ void (*tkInstallFrameMenu) _ANSI_ARGS_((Tk_Window tkwin)); /* 45 */
+ char * (*tkKeysymToString) _ANSI_ARGS_((KeySym keysym)); /* 46 */
+ int (*tkLineToArea) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double rectPtr[])); /* 47 */
+ double (*tkLineToPoint) _ANSI_ARGS_((double end1Ptr[], double end2Ptr[], double pointPtr[])); /* 48 */
+ int (*tkMakeBezierCurve) _ANSI_ARGS_((Tk_Canvas canvas, double * pointPtr, int numPoints, int numSteps, XPoint xPoints[], double dblPoints[])); /* 49 */
+ void (*tkMakeBezierPostscript) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Canvas canvas, double * pointPtr, int numPoints)); /* 50 */
+ void (*tkOptionClassChanged) _ANSI_ARGS_((TkWindow * winPtr)); /* 51 */
+ void (*tkOptionDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 52 */
+ int (*tkOvalToArea) _ANSI_ARGS_((double * ovalPtr, double * rectPtr)); /* 53 */
+ double (*tkOvalToPoint) _ANSI_ARGS_((double ovalPtr[], double width, int filled, double pointPtr[])); /* 54 */
+ int (*tkpChangeFocus) _ANSI_ARGS_((TkWindow * winPtr, int force)); /* 55 */
+ void (*tkpCloseDisplay) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 56 */
+ void (*tkpClaimFocus) _ANSI_ARGS_((TkWindow * topLevelPtr, int force)); /* 57 */
+ void (*tkpDisplayWarning) _ANSI_ARGS_((char * msg, char * title)); /* 58 */
+ void (*tkpGetAppName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * name)); /* 59 */
+ TkWindow * (*tkpGetOtherWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 60 */
+ TkWindow * (*tkpGetWrapperWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 61 */
+ int (*tkpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 62 */
+ void (*tkpInitializeMenuBindings) _ANSI_ARGS_((Tcl_Interp * interp, Tk_BindingTable bindingTable)); /* 63 */
+ void (*tkpMakeContainer) _ANSI_ARGS_((Tk_Window tkwin)); /* 64 */
+ void (*tkpMakeMenuWindow) _ANSI_ARGS_((Tk_Window tkwin, int transient)); /* 65 */
+ Window (*tkpMakeWindow) _ANSI_ARGS_((TkWindow * winPtr, Window parent)); /* 66 */
+ void (*tkpMenuNotifyToplevelCreate) _ANSI_ARGS_((Tcl_Interp * interp1, char * menuName)); /* 67 */
+ TkDisplay * (*tkpOpenDisplay) _ANSI_ARGS_((char * display_name)); /* 68 */
+ int (*tkPointerEvent) _ANSI_ARGS_((XEvent * eventPtr, TkWindow * winPtr)); /* 69 */
+ int (*tkPolygonToArea) _ANSI_ARGS_((double * polyPtr, int numPoints, double * rectPtr)); /* 70 */
+ double (*tkPolygonToPoint) _ANSI_ARGS_((double * polyPtr, int numPoints, double * pointPtr)); /* 71 */
+ int (*tkPositionInTree) _ANSI_ARGS_((TkWindow * winPtr, TkWindow * treePtr)); /* 72 */
+ void (*tkpRedirectKeyEvent) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 73 */
+ void (*tkpSetMainMenubar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * menuName)); /* 74 */
+ int (*tkpUseWindow) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * string)); /* 75 */
+ int (*tkpWindowWasRecentlyDeleted) _ANSI_ARGS_((Window win, TkDisplay * dispPtr)); /* 76 */
+ void (*tkQueueEventForAllChildren) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr)); /* 77 */
+ int (*tkReadBitmapFile) _ANSI_ARGS_((Display* display, Drawable d, CONST char* filename, unsigned int* width_return, unsigned int* height_return, Pixmap* bitmap_return, int* x_hot_return, int* y_hot_return)); /* 78 */
+ int (*tkScrollWindow) _ANSI_ARGS_((Tk_Window tkwin, GC gc, int x, int y, int width, int height, int dx, int dy, TkRegion damageRgn)); /* 79 */
+ void (*tkSelDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 80 */
+ void (*tkSelEventProc) _ANSI_ARGS_((Tk_Window tkwin, XEvent * eventPtr)); /* 81 */
+ void (*tkSelInit) _ANSI_ARGS_((Tk_Window tkwin)); /* 82 */
+ void (*tkSelPropProc) _ANSI_ARGS_((XEvent * eventPtr)); /* 83 */
+ void (*tkSetClassProcs) _ANSI_ARGS_((Tk_Window tkwin, TkClassProcs * procs, ClientData instanceData)); /* 84 */
+ void (*tkSetWindowMenuBar) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, char * oldMenuName, char * menuName)); /* 85 */
+ KeySym (*tkStringToKeysym) _ANSI_ARGS_((char * name)); /* 86 */
+ int (*tkThickPolyLineToArea) _ANSI_ARGS_((double * coordPtr, int numPoints, double width, int capStyle, int joinStyle, double * rectPtr)); /* 87 */
+ void (*tkWmAddToColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 88 */
+ void (*tkWmDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 89 */
+ TkWindow * (*tkWmFocusToplevel) _ANSI_ARGS_((TkWindow * winPtr)); /* 90 */
+ void (*tkWmMapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 91 */
+ void (*tkWmNewWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 92 */
+ void (*tkWmProtocolEventProc) _ANSI_ARGS_((TkWindow * winPtr, XEvent * evenvPtr)); /* 93 */
+ void (*tkWmRemoveFromColormapWindows) _ANSI_ARGS_((TkWindow * winPtr)); /* 94 */
+ void (*tkWmRestackToplevel) _ANSI_ARGS_((TkWindow * winPtr, int aboveBelow, TkWindow * otherPtr)); /* 95 */
+ void (*tkWmSetClass) _ANSI_ARGS_((TkWindow * winPtr)); /* 96 */
+ void (*tkWmUnmapWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 97 */
+ Tcl_Obj * (*tkDebugBitmap) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 98 */
+ Tcl_Obj * (*tkDebugBorder) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 99 */
+ Tcl_Obj * (*tkDebugCursor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 100 */
+ Tcl_Obj * (*tkDebugColor) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 101 */
+ Tcl_Obj * (*tkDebugConfig) _ANSI_ARGS_((Tcl_Interp * interp, Tk_OptionTable table)); /* 102 */
+ Tcl_Obj * (*tkDebugFont) _ANSI_ARGS_((Tk_Window tkwin, char * name)); /* 103 */
+ int (*tkFindStateNumObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * optionPtr, CONST TkStateMap * mapPtr, Tcl_Obj * keyPtr)); /* 104 */
+ Tcl_HashTable * (*tkGetBitmapPredefTable) _ANSI_ARGS_((void)); /* 105 */
+ TkDisplay * (*tkGetDisplayList) _ANSI_ARGS_((void)); /* 106 */
+ TkMainInfo * (*tkGetMainInfoList) _ANSI_ARGS_((void)); /* 107 */
+ int (*tkGetWindowFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Window tkwin, Tcl_Obj * objPtr, Tk_Window * windowPtr)); /* 108 */
+ char * (*tkpGetString) _ANSI_ARGS_((TkWindow * winPtr, XEvent * eventPtr, Tcl_DString * dsPtr)); /* 109 */
+ void (*tkpGetSubFonts) _ANSI_ARGS_((Tcl_Interp * interp, Tk_Font tkfont)); /* 110 */
+ Tcl_Obj * (*tkpGetSystemDefault) _ANSI_ARGS_((Tk_Window tkwin, char * dbName, char * className)); /* 111 */
+ void (*tkpMenuThreadInit) _ANSI_ARGS_((void)); /* 112 */
+#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 */
+#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 */
+#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 */
+#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 */
+#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 */
+#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 */
+#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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved120;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved120;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 120 */
+#endif /* MAC_TCL */
+#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, char * source)); /* 121 */
+#endif /* MAC_TCL */
+#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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved123;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved123;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 123 */
+#endif /* MAC_TCL */
+#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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved125;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved125;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkPointerDeadWindow) _ANSI_ARGS_((TkWindow * winPtr)); /* 125 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved126;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved126;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkpSetCapture) _ANSI_ARGS_((TkWindow * winPtr)); /* 126 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved127;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved127;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkpSetCursor) _ANSI_ARGS_((TkpCursor cursor)); /* 127 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved128;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved128;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkpWmSetState) _ANSI_ARGS_((TkWindow * winPtr, int state)); /* 128 */
+#endif /* MAC_TCL */
+ void *reserved129;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved130;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved130;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ Window (*tkGetTransientMaster) _ANSI_ARGS_((TkWindow * winPtr)); /* 130 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved131;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved131;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ int (*tkGenerateButtonEvent) _ANSI_ARGS_((int x, int y, Window window, unsigned int state)); /* 131 */
+#endif /* MAC_TCL */
+ void *reserved132;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved133;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved133;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkGenWMDestroyEvent) _ANSI_ARGS_((Tk_Window tkwin)); /* 133 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void *reserved134;
+#endif /* UNIX */
+#ifdef __WIN32__
+ void *reserved134;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 134 */
+#endif /* MAC_TCL */
+ 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 */
+} 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
+#ifndef TkSetClassProcs
+#define TkSetClassProcs \
+ (tkIntStubsPtr->tkSetClassProcs) /* 84 */
+#endif
+#ifndef TkSetWindowMenuBar
+#define TkSetWindowMenuBar \
+ (tkIntStubsPtr->tkSetWindowMenuBar) /* 85 */
+#endif
+#ifndef TkStringToKeysym
+#define TkStringToKeysym \
+ (tkIntStubsPtr->tkStringToKeysym) /* 86 */
+#endif
+#ifndef TkThickPolyLineToArea
+#define TkThickPolyLineToArea \
+ (tkIntStubsPtr->tkThickPolyLineToArea) /* 87 */
+#endif
+#ifndef TkWmAddToColormapWindows
+#define TkWmAddToColormapWindows \
+ (tkIntStubsPtr->tkWmAddToColormapWindows) /* 88 */
+#endif
+#ifndef TkWmDeadWindow
+#define TkWmDeadWindow \
+ (tkIntStubsPtr->tkWmDeadWindow) /* 89 */
+#endif
+#ifndef TkWmFocusToplevel
+#define TkWmFocusToplevel \
+ (tkIntStubsPtr->tkWmFocusToplevel) /* 90 */
+#endif
+#ifndef TkWmMapWindow
+#define TkWmMapWindow \
+ (tkIntStubsPtr->tkWmMapWindow) /* 91 */
+#endif
+#ifndef TkWmNewWindow
+#define TkWmNewWindow \
+ (tkIntStubsPtr->tkWmNewWindow) /* 92 */
+#endif
+#ifndef TkWmProtocolEventProc
+#define TkWmProtocolEventProc \
+ (tkIntStubsPtr->tkWmProtocolEventProc) /* 93 */
+#endif
+#ifndef TkWmRemoveFromColormapWindows
+#define TkWmRemoveFromColormapWindows \
+ (tkIntStubsPtr->tkWmRemoveFromColormapWindows) /* 94 */
+#endif
+#ifndef TkWmRestackToplevel
+#define TkWmRestackToplevel \
+ (tkIntStubsPtr->tkWmRestackToplevel) /* 95 */
+#endif
+#ifndef TkWmSetClass
+#define TkWmSetClass \
+ (tkIntStubsPtr->tkWmSetClass) /* 96 */
+#endif
+#ifndef TkWmUnmapWindow
+#define TkWmUnmapWindow \
+ (tkIntStubsPtr->tkWmUnmapWindow) /* 97 */
+#endif
+#ifndef TkDebugBitmap
+#define TkDebugBitmap \
+ (tkIntStubsPtr->tkDebugBitmap) /* 98 */
+#endif
+#ifndef TkDebugBorder
+#define TkDebugBorder \
+ (tkIntStubsPtr->tkDebugBorder) /* 99 */
+#endif
+#ifndef TkDebugCursor
+#define TkDebugCursor \
+ (tkIntStubsPtr->tkDebugCursor) /* 100 */
+#endif
+#ifndef TkDebugColor
+#define TkDebugColor \
+ (tkIntStubsPtr->tkDebugColor) /* 101 */
+#endif
+#ifndef TkDebugConfig
+#define TkDebugConfig \
+ (tkIntStubsPtr->tkDebugConfig) /* 102 */
+#endif
+#ifndef TkDebugFont
+#define TkDebugFont \
+ (tkIntStubsPtr->tkDebugFont) /* 103 */
+#endif
+#ifndef TkFindStateNumObj
+#define TkFindStateNumObj \
+ (tkIntStubsPtr->tkFindStateNumObj) /* 104 */
+#endif
+#ifndef TkGetBitmapPredefTable
+#define TkGetBitmapPredefTable \
+ (tkIntStubsPtr->tkGetBitmapPredefTable) /* 105 */
+#endif
+#ifndef TkGetDisplayList
+#define TkGetDisplayList \
+ (tkIntStubsPtr->tkGetDisplayList) /* 106 */
+#endif
+#ifndef TkGetMainInfoList
+#define TkGetMainInfoList \
+ (tkIntStubsPtr->tkGetMainInfoList) /* 107 */
+#endif
+#ifndef TkGetWindowFromObj
+#define TkGetWindowFromObj \
+ (tkIntStubsPtr->tkGetWindowFromObj) /* 108 */
+#endif
+#ifndef TkpGetString
+#define TkpGetString \
+ (tkIntStubsPtr->tkpGetString) /* 109 */
+#endif
+#ifndef TkpGetSubFonts
+#define TkpGetSubFonts \
+ (tkIntStubsPtr->tkpGetSubFonts) /* 110 */
+#endif
+#ifndef TkpGetSystemDefault
+#define TkpGetSystemDefault \
+ (tkIntStubsPtr->tkpGetSystemDefault) /* 111 */
+#endif
+#ifndef TkpMenuThreadInit
+#define TkpMenuThreadInit \
+ (tkIntStubsPtr->tkpMenuThreadInit) /* 112 */
+#endif
+#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 __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 __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 __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 __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 __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 __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_TCL
+#ifndef TkGenerateActivateEvents
+#define TkGenerateActivateEvents \
+ (tkIntStubsPtr->tkGenerateActivateEvents) /* 120 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpCreateNativeBitmap
+#define TkpCreateNativeBitmap \
+ (tkIntStubsPtr->tkpCreateNativeBitmap) /* 121 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpDefineNativeBitmaps
+#define TkpDefineNativeBitmaps \
+ (tkIntStubsPtr->tkpDefineNativeBitmaps) /* 122 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpGetMS
+#define TkpGetMS \
+ (tkIntStubsPtr->tkpGetMS) /* 123 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpGetNativeAppBitmap
+#define TkpGetNativeAppBitmap \
+ (tkIntStubsPtr->tkpGetNativeAppBitmap) /* 124 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkPointerDeadWindow
+#define TkPointerDeadWindow \
+ (tkIntStubsPtr->tkPointerDeadWindow) /* 125 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpSetCapture
+#define TkpSetCapture \
+ (tkIntStubsPtr->tkpSetCapture) /* 126 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpSetCursor
+#define TkpSetCursor \
+ (tkIntStubsPtr->tkpSetCursor) /* 127 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkpWmSetState
+#define TkpWmSetState \
+ (tkIntStubsPtr->tkpWmSetState) /* 128 */
+#endif
+#endif /* MAC_TCL */
+/* Slot 129 is reserved */
+#ifdef MAC_TCL
+#ifndef TkGetTransientMaster
+#define TkGetTransientMaster \
+ (tkIntStubsPtr->tkGetTransientMaster) /* 130 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkGenerateButtonEvent
+#define TkGenerateButtonEvent \
+ (tkIntStubsPtr->tkGenerateButtonEvent) /* 131 */
+#endif
+#endif /* MAC_TCL */
+/* Slot 132 is reserved */
+#ifdef MAC_TCL
+#ifndef TkGenWMDestroyEvent
+#define TkGenWMDestroyEvent \
+ (tkIntStubsPtr->tkGenWMDestroyEvent) /* 133 */
+#endif
+#endif /* MAC_TCL */
+#ifdef MAC_TCL
+#ifndef TkGenWMConfigureEvent
+#define TkGenWMConfigureEvent \
+ (tkIntStubsPtr->tkGenWMConfigureEvent) /* 134 */
+#endif
+#endif /* MAC_TCL */
+#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
+
+#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/tk/generic/tkIntPlatDecls.h b/tk/generic/tkIntPlatDecls.h
new file mode 100644
index 00000000000..d3240233fe8
--- /dev/null
+++ b/tk/generic/tkIntPlatDecls.h
@@ -0,0 +1,885 @@
+/*
+ * 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:
+ */
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 0 */
+EXTERN void TkCreateXEventSource _ANSI_ARGS_((void));
+/* 1 */
+EXTERN void TkFreeWindowId _ANSI_ARGS_((TkDisplay * dispPtr,
+ Window w));
+/* 2 */
+EXTERN void TkInitXId _ANSI_ARGS_((TkDisplay * dispPtr));
+/* 3 */
+EXTERN int TkpCmapStressed _ANSI_ARGS_((Tk_Window tkwin,
+ Colormap colormap));
+/* 4 */
+EXTERN void TkpSync _ANSI_ARGS_((Display * display));
+/* 5 */
+EXTERN Window TkUnixContainerId _ANSI_ARGS_((TkWindow * winPtr));
+/* 6 */
+EXTERN int TkUnixDoOneXEvent _ANSI_ARGS_((Tcl_Time * timePtr));
+/* 7 */
+EXTERN void TkUnixSetMenubar _ANSI_ARGS_((Tk_Window tkwin,
+ Tk_Window menubar));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 0 */
+EXTERN char * TkAlignImageData _ANSI_ARGS_((XImage * image,
+ int alignment, int bitOrder));
+/* 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,
+ char * string, int * 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, char * dbName,
+ char * className));
+/* 33 */
+EXTERN int TkWinGetPlatformId _ANSI_ARGS_((void));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+/* 0 */
+EXTERN void TkGenerateActivateEvents _ANSI_ARGS_((
+ TkWindow * winPtr, int active));
+/* 1 */
+EXTERN Pixmap TkpCreateNativeBitmap _ANSI_ARGS_((Display * display,
+ char * source));
+/* 2 */
+EXTERN void TkpDefineNativeBitmaps _ANSI_ARGS_((void));
+/* 3 */
+EXTERN unsigned long TkpGetMS _ANSI_ARGS_((void));
+/* 4 */
+EXTERN Pixmap TkpGetNativeAppBitmap _ANSI_ARGS_((Display * display,
+ char * name, int * width, int * height));
+/* 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));
+/* 9 */
+EXTERN int HandleWMEvent _ANSI_ARGS_((EventRecord * theEvent));
+/* 10 */
+EXTERN void TkAboutDlg _ANSI_ARGS_((void));
+/* 11 */
+EXTERN void TkCreateMacEventSource _ANSI_ARGS_((void));
+/* 12 */
+EXTERN void TkFontList _ANSI_ARGS_((Tcl_Interp * interp,
+ Display * display));
+/* 13 */
+EXTERN Window TkGetTransientMaster _ANSI_ARGS_((TkWindow * winPtr));
+/* 14 */
+EXTERN int TkGenerateButtonEvent _ANSI_ARGS_((int x, int y,
+ Window window, unsigned int state));
+/* 15 */
+EXTERN int TkGetCharPositions _ANSI_ARGS_((
+ XFontStruct * font_struct, char * string,
+ int count, short * buffer));
+/* 16 */
+EXTERN void TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
+/* 17 */
+EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height,
+ int flags));
+/* 18 */
+EXTERN unsigned int TkMacButtonKeyState _ANSI_ARGS_((void));
+/* 19 */
+EXTERN void TkMacClearMenubarActive _ANSI_ARGS_((void));
+/* 20 */
+EXTERN int TkMacConvertEvent _ANSI_ARGS_((
+ EventRecord * eventPtr));
+/* 21 */
+EXTERN int TkMacDispatchMenuEvent _ANSI_ARGS_((int menuID,
+ int index));
+/* 22 */
+EXTERN void TkMacInstallCursor _ANSI_ARGS_((int resizeOverride));
+/* 23 */
+EXTERN int TkMacConvertTkEvent _ANSI_ARGS_((
+ EventRecord * eventPtr, Window window));
+/* 24 */
+EXTERN void TkMacHandleTearoffMenu _ANSI_ARGS_((void));
+/* 25 */
+EXTERN void tkMacInstallMWConsole _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 26 */
+EXTERN void TkMacInvalClipRgns _ANSI_ARGS_((TkWindow * winPtr));
+/* 27 */
+EXTERN void TkMacDoHLEvent _ANSI_ARGS_((EventRecord * theEvent));
+/* 28 */
+EXTERN void TkMacFontInfo _ANSI_ARGS_((Font fontId,
+ short * family, short * style, short * size));
+/* 29 */
+EXTERN Time TkMacGenerateTime _ANSI_ARGS_((void));
+/* 30 */
+EXTERN GWorldPtr TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
+/* 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));
+/* 35 */
+EXTERN int TkMacHaveAppearance _ANSI_ARGS_((void));
+/* 36 */
+EXTERN void TkMacInitAppleEvents _ANSI_ARGS_((
+ Tcl_Interp * interp));
+/* 37 */
+EXTERN void TkMacInitMenus _ANSI_ARGS_((Tcl_Interp * interp));
+/* 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));
+/* 45 */
+EXTERN void TkMacSetEmbedRgn _ANSI_ARGS_((TkWindow * winPtr,
+ RgnHandle rgn));
+/* 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));
+/* 56 */
+EXTERN void TkResumeClipboard _ANSI_ARGS_((void));
+/* 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));
+/* 60 */
+EXTERN int TkWMGrowToplevel _ANSI_ARGS_((WindowRef whichWindow,
+ Point start));
+/* 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));
+#endif /* MAC_TCL */
+
+typedef struct TkIntPlatStubs {
+ int magic;
+ struct TkIntPlatStubHooks *hooks;
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ void (*tkCreateXEventSource) _ANSI_ARGS_((void)); /* 0 */
+ void (*tkFreeWindowId) _ANSI_ARGS_((TkDisplay * dispPtr, Window w)); /* 1 */
+ void (*tkInitXId) _ANSI_ARGS_((TkDisplay * dispPtr)); /* 2 */
+ int (*tkpCmapStressed) _ANSI_ARGS_((Tk_Window tkwin, Colormap colormap)); /* 3 */
+ void (*tkpSync) _ANSI_ARGS_((Display * display)); /* 4 */
+ Window (*tkUnixContainerId) _ANSI_ARGS_((TkWindow * winPtr)); /* 5 */
+ int (*tkUnixDoOneXEvent) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 6 */
+ void (*tkUnixSetMenubar) _ANSI_ARGS_((Tk_Window tkwin, Tk_Window menubar)); /* 7 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ char * (*tkAlignImageData) _ANSI_ARGS_((XImage * image, int alignment, int bitOrder)); /* 0 */
+ void *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, char * string, int * 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, char * dbName, char * className)); /* 32 */
+ int (*tkWinGetPlatformId) _ANSI_ARGS_((void)); /* 33 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tkGenerateActivateEvents) _ANSI_ARGS_((TkWindow * winPtr, int active)); /* 0 */
+ Pixmap (*tkpCreateNativeBitmap) _ANSI_ARGS_((Display * display, char * source)); /* 1 */
+ void (*tkpDefineNativeBitmaps) _ANSI_ARGS_((void)); /* 2 */
+ unsigned long (*tkpGetMS) _ANSI_ARGS_((void)); /* 3 */
+ Pixmap (*tkpGetNativeAppBitmap) _ANSI_ARGS_((Display * display, char * name, int * width, int * height)); /* 4 */
+ 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 */
+ int (*handleWMEvent) _ANSI_ARGS_((EventRecord * theEvent)); /* 9 */
+ void (*tkAboutDlg) _ANSI_ARGS_((void)); /* 10 */
+ void (*tkCreateMacEventSource) _ANSI_ARGS_((void)); /* 11 */
+ void (*tkFontList) _ANSI_ARGS_((Tcl_Interp * interp, Display * display)); /* 12 */
+ Window (*tkGetTransientMaster) _ANSI_ARGS_((TkWindow * winPtr)); /* 13 */
+ int (*tkGenerateButtonEvent) _ANSI_ARGS_((int x, int y, Window window, unsigned int state)); /* 14 */
+ int (*tkGetCharPositions) _ANSI_ARGS_((XFontStruct * font_struct, char * string, int count, short * buffer)); /* 15 */
+ void (*tkGenWMDestroyEvent) _ANSI_ARGS_((Tk_Window tkwin)); /* 16 */
+ void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 17 */
+ unsigned int (*tkMacButtonKeyState) _ANSI_ARGS_((void)); /* 18 */
+ void (*tkMacClearMenubarActive) _ANSI_ARGS_((void)); /* 19 */
+ int (*tkMacConvertEvent) _ANSI_ARGS_((EventRecord * eventPtr)); /* 20 */
+ int (*tkMacDispatchMenuEvent) _ANSI_ARGS_((int menuID, int index)); /* 21 */
+ void (*tkMacInstallCursor) _ANSI_ARGS_((int resizeOverride)); /* 22 */
+ int (*tkMacConvertTkEvent) _ANSI_ARGS_((EventRecord * eventPtr, Window window)); /* 23 */
+ void (*tkMacHandleTearoffMenu) _ANSI_ARGS_((void)); /* 24 */
+ void (*tkMacInstallMWConsole) _ANSI_ARGS_((Tcl_Interp * interp)); /* 25 */
+ void (*tkMacInvalClipRgns) _ANSI_ARGS_((TkWindow * winPtr)); /* 26 */
+ void (*tkMacDoHLEvent) _ANSI_ARGS_((EventRecord * theEvent)); /* 27 */
+ void (*tkMacFontInfo) _ANSI_ARGS_((Font fontId, short * family, short * style, short * size)); /* 28 */
+ Time (*tkMacGenerateTime) _ANSI_ARGS_((void)); /* 29 */
+ GWorldPtr (*tkMacGetDrawablePort) _ANSI_ARGS_((Drawable drawable)); /* 30 */
+ 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 */
+ int (*tkMacHaveAppearance) _ANSI_ARGS_((void)); /* 35 */
+ void (*tkMacInitAppleEvents) _ANSI_ARGS_((Tcl_Interp * interp)); /* 36 */
+ void (*tkMacInitMenus) _ANSI_ARGS_((Tcl_Interp * interp)); /* 37 */
+ 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 (*tkMacSetEmbedRgn) _ANSI_ARGS_((TkWindow * winPtr, RgnHandle rgn)); /* 45 */
+ 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 (*tkResumeClipboard) _ANSI_ARGS_((void)); /* 56 */
+ 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 */
+ int (*tkWMGrowToplevel) _ANSI_ARGS_((WindowRef whichWindow, Point start)); /* 60 */
+ 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 */
+#endif /* MAC_TCL */
+} 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:
+ */
+
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TkCreateXEventSource
+#define TkCreateXEventSource \
+ (tkIntPlatStubsPtr->tkCreateXEventSource) /* 0 */
+#endif
+#ifndef TkFreeWindowId
+#define TkFreeWindowId \
+ (tkIntPlatStubsPtr->tkFreeWindowId) /* 1 */
+#endif
+#ifndef TkInitXId
+#define TkInitXId \
+ (tkIntPlatStubsPtr->tkInitXId) /* 2 */
+#endif
+#ifndef TkpCmapStressed
+#define TkpCmapStressed \
+ (tkIntPlatStubsPtr->tkpCmapStressed) /* 3 */
+#endif
+#ifndef TkpSync
+#define TkpSync \
+ (tkIntPlatStubsPtr->tkpSync) /* 4 */
+#endif
+#ifndef TkUnixContainerId
+#define TkUnixContainerId \
+ (tkIntPlatStubsPtr->tkUnixContainerId) /* 5 */
+#endif
+#ifndef TkUnixDoOneXEvent
+#define TkUnixDoOneXEvent \
+ (tkIntPlatStubsPtr->tkUnixDoOneXEvent) /* 6 */
+#endif
+#ifndef TkUnixSetMenubar
+#define TkUnixSetMenubar \
+ (tkIntPlatStubsPtr->tkUnixSetMenubar) /* 7 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TkAlignImageData
+#define TkAlignImageData \
+ (tkIntPlatStubsPtr->tkAlignImageData) /* 0 */
+#endif
+/* 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
+#ifndef TkpCreateNativeBitmap
+#define TkpCreateNativeBitmap \
+ (tkIntPlatStubsPtr->tkpCreateNativeBitmap) /* 1 */
+#endif
+#ifndef TkpDefineNativeBitmaps
+#define TkpDefineNativeBitmaps \
+ (tkIntPlatStubsPtr->tkpDefineNativeBitmaps) /* 2 */
+#endif
+#ifndef TkpGetMS
+#define TkpGetMS \
+ (tkIntPlatStubsPtr->tkpGetMS) /* 3 */
+#endif
+#ifndef TkpGetNativeAppBitmap
+#define TkpGetNativeAppBitmap \
+ (tkIntPlatStubsPtr->tkpGetNativeAppBitmap) /* 4 */
+#endif
+#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
+#ifndef HandleWMEvent
+#define HandleWMEvent \
+ (tkIntPlatStubsPtr->handleWMEvent) /* 9 */
+#endif
+#ifndef TkAboutDlg
+#define TkAboutDlg \
+ (tkIntPlatStubsPtr->tkAboutDlg) /* 10 */
+#endif
+#ifndef TkCreateMacEventSource
+#define TkCreateMacEventSource \
+ (tkIntPlatStubsPtr->tkCreateMacEventSource) /* 11 */
+#endif
+#ifndef TkFontList
+#define TkFontList \
+ (tkIntPlatStubsPtr->tkFontList) /* 12 */
+#endif
+#ifndef TkGetTransientMaster
+#define TkGetTransientMaster \
+ (tkIntPlatStubsPtr->tkGetTransientMaster) /* 13 */
+#endif
+#ifndef TkGenerateButtonEvent
+#define TkGenerateButtonEvent \
+ (tkIntPlatStubsPtr->tkGenerateButtonEvent) /* 14 */
+#endif
+#ifndef TkGetCharPositions
+#define TkGetCharPositions \
+ (tkIntPlatStubsPtr->tkGetCharPositions) /* 15 */
+#endif
+#ifndef TkGenWMDestroyEvent
+#define TkGenWMDestroyEvent \
+ (tkIntPlatStubsPtr->tkGenWMDestroyEvent) /* 16 */
+#endif
+#ifndef TkGenWMConfigureEvent
+#define TkGenWMConfigureEvent \
+ (tkIntPlatStubsPtr->tkGenWMConfigureEvent) /* 17 */
+#endif
+#ifndef TkMacButtonKeyState
+#define TkMacButtonKeyState \
+ (tkIntPlatStubsPtr->tkMacButtonKeyState) /* 18 */
+#endif
+#ifndef TkMacClearMenubarActive
+#define TkMacClearMenubarActive \
+ (tkIntPlatStubsPtr->tkMacClearMenubarActive) /* 19 */
+#endif
+#ifndef TkMacConvertEvent
+#define TkMacConvertEvent \
+ (tkIntPlatStubsPtr->tkMacConvertEvent) /* 20 */
+#endif
+#ifndef TkMacDispatchMenuEvent
+#define TkMacDispatchMenuEvent \
+ (tkIntPlatStubsPtr->tkMacDispatchMenuEvent) /* 21 */
+#endif
+#ifndef TkMacInstallCursor
+#define TkMacInstallCursor \
+ (tkIntPlatStubsPtr->tkMacInstallCursor) /* 22 */
+#endif
+#ifndef TkMacConvertTkEvent
+#define TkMacConvertTkEvent \
+ (tkIntPlatStubsPtr->tkMacConvertTkEvent) /* 23 */
+#endif
+#ifndef TkMacHandleTearoffMenu
+#define TkMacHandleTearoffMenu \
+ (tkIntPlatStubsPtr->tkMacHandleTearoffMenu) /* 24 */
+#endif
+#ifndef tkMacInstallMWConsole
+#define tkMacInstallMWConsole \
+ (tkIntPlatStubsPtr->tkMacInstallMWConsole) /* 25 */
+#endif
+#ifndef TkMacInvalClipRgns
+#define TkMacInvalClipRgns \
+ (tkIntPlatStubsPtr->tkMacInvalClipRgns) /* 26 */
+#endif
+#ifndef TkMacDoHLEvent
+#define TkMacDoHLEvent \
+ (tkIntPlatStubsPtr->tkMacDoHLEvent) /* 27 */
+#endif
+#ifndef TkMacFontInfo
+#define TkMacFontInfo \
+ (tkIntPlatStubsPtr->tkMacFontInfo) /* 28 */
+#endif
+#ifndef TkMacGenerateTime
+#define TkMacGenerateTime \
+ (tkIntPlatStubsPtr->tkMacGenerateTime) /* 29 */
+#endif
+#ifndef TkMacGetDrawablePort
+#define TkMacGetDrawablePort \
+ (tkIntPlatStubsPtr->tkMacGetDrawablePort) /* 30 */
+#endif
+#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
+#ifndef TkMacHaveAppearance
+#define TkMacHaveAppearance \
+ (tkIntPlatStubsPtr->tkMacHaveAppearance) /* 35 */
+#endif
+#ifndef TkMacInitAppleEvents
+#define TkMacInitAppleEvents \
+ (tkIntPlatStubsPtr->tkMacInitAppleEvents) /* 36 */
+#endif
+#ifndef TkMacInitMenus
+#define TkMacInitMenus \
+ (tkIntPlatStubsPtr->tkMacInitMenus) /* 37 */
+#endif
+#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
+#ifndef TkMacSetEmbedRgn
+#define TkMacSetEmbedRgn \
+ (tkIntPlatStubsPtr->tkMacSetEmbedRgn) /* 45 */
+#endif
+#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
+#ifndef TkResumeClipboard
+#define TkResumeClipboard \
+ (tkIntPlatStubsPtr->tkResumeClipboard) /* 56 */
+#endif
+#ifndef TkSetMacColor
+#define TkSetMacColor \
+ (tkIntPlatStubsPtr->tkSetMacColor) /* 57 */
+#endif
+#ifndef TkSetWMName
+#define TkSetWMName \
+ (tkIntPlatStubsPtr->tkSetWMName) /* 58 */
+#endif
+#ifndef TkSuspendClipboard
+#define TkSuspendClipboard \
+ (tkIntPlatStubsPtr->tkSuspendClipboard) /* 59 */
+#endif
+#ifndef TkWMGrowToplevel
+#define TkWMGrowToplevel \
+ (tkIntPlatStubsPtr->tkWMGrowToplevel) /* 60 */
+#endif
+#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
+#endif /* MAC_TCL */
+
+#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
+
+/* !END!: Do not edit above this line. */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKINTPLATDECLS */
diff --git a/tk/generic/tkIntXlibDecls.h b/tk/generic/tkIntXlibDecls.h
new file mode 100644
index 00000000000..7126dd6bcc6
--- /dev/null
+++ b/tk/generic/tkIntXlibDecls.h
@@ -0,0 +1,1674 @@
+/*
+ * 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,
+ 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 */
+
+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, 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 */
+} 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 */
+
+#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/tk/generic/tkListbox.c b/tk/generic/tkListbox.c
index 9e32979956c..f6b0f75f6ca 100644
--- a/tk/generic/tkListbox.c
+++ b/tk/generic/tkListbox.c
@@ -18,30 +18,13 @@
#include "default.h"
#include "tkInt.h"
-/*
- * One record of the following type is kept for each element
- * associated with a listbox widget:
- */
-
-typedef struct Element {
- int textLength; /* # non-NULL characters in text. */
- int lBearing; /* Distance from first character's
- * origin to left edge of character. */
- int pixelWidth; /* Total width of element in pixels (including
- * left bearing and right bearing). */
- int selected; /* 1 means this item is selected, 0 means
- * it isn't. */
- struct Element *nextPtr; /* Next in list of all elements of this
- * listbox, or NULL for last element. */
- char text[4]; /* Characters of this element, NULL-
- * terminated. The actual space allocated
- * here will be as large as needed (> 4,
- * most likely). Must be the last field
- * of the record. */
-} Element;
-
-#define ElementSize(stringLength) \
- ((unsigned) (sizeof(Element) - 3 + stringLength))
+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
@@ -58,11 +41,16 @@ typedef struct {
* freed even after tkwin has gone away. */
Tcl_Interp *interp; /* Interpreter associated with listbox. */
Tcl_Command widgetCmd; /* Token for listbox's widget command. */
- int numElements; /* Total number of elements in this listbox. */
- Element *firstPtr; /* First in list of elements (NULL if no
- * elements). */
- Element *lastPtr; /* Last in list of elements (NULL if no
- * elements). */
+ 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:
@@ -172,6 +160,17 @@ typedef struct {
} 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
@@ -183,106 +182,184 @@ typedef struct {
* 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
/*
- * Information used for argv parsing:
+ * The optionSpecs table defines the valid configuration options for the
+ * listbox widget
*/
+static Tk_OptionSpec optionSpecs[] = {
+ {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_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, "-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}
+};
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_LISTBOX_BG_COLOR, Tk_Offset(Listbox, normalBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_LISTBOX_BG_MONO, Tk_Offset(Listbox, normalBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_LISTBOX_BORDER_WIDTH, Tk_Offset(Listbox, borderWidth), 0},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_LISTBOX_CURSOR, Tk_Offset(Listbox, cursor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
- "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION,
- Tk_Offset(Listbox, exportSelection), 0},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_LISTBOX_FONT, Tk_Offset(Listbox, tkfont), 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_LISTBOX_FG, Tk_Offset(Listbox, fgColorPtr), 0},
- {TK_CONFIG_INT, "-height", "height", "Height",
- DEF_LISTBOX_HEIGHT, Tk_Offset(Listbox, height), 0},
- {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
- "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG,
- Tk_Offset(Listbox, highlightBgColorPtr), 0},
- {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
- DEF_LISTBOX_HIGHLIGHT, Tk_Offset(Listbox, highlightColorPtr), 0},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
- "HighlightThickness",
- DEF_LISTBOX_HIGHLIGHT_WIDTH, Tk_Offset(Listbox, highlightWidth), 0},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_LISTBOX_RELIEF, Tk_Offset(Listbox, relief), 0},
- {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
- DEF_LISTBOX_SELECT_COLOR, Tk_Offset(Listbox, selBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
- DEF_LISTBOX_SELECT_MONO, Tk_Offset(Listbox, selBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
- DEF_LISTBOX_SELECT_BD, Tk_Offset(Listbox, selBorderWidth), 0},
- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
- DEF_LISTBOX_SELECT_FG_COLOR, Tk_Offset(Listbox, selFgColorPtr),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
- DEF_LISTBOX_SELECT_FG_MONO, Tk_Offset(Listbox, selFgColorPtr),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
- DEF_LISTBOX_SELECT_MODE, Tk_Offset(Listbox, selectMode), 0},
- {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
- DEF_LISTBOX_SET_GRID, Tk_Offset(Listbox, setGrid), 0},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_LISTBOX_TAKE_FOCUS, Tk_Offset(Listbox, takeFocus),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_INT, "-width", "width", "Width",
- DEF_LISTBOX_WIDTH, Tk_Offset(Listbox, width), 0},
- {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
- DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, xScrollCmd),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
- DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, yScrollCmd),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+/*
+ * 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}
};
/*
- * Forward declarations for procedures defined later in this file:
+ * 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 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 char *selCommandNames[] = {
+ "anchor", "clear", "includes", "set", (char *) NULL
+};
+
+enum selcommand {
+ SELECTION_ANCHOR, SELECTION_CLEAR, SELECTION_INCLUDES, SELECTION_SET
+};
+
+static char *scanCommandNames[] = {
+ "mark", "dragto", (char *) NULL
+};
+
+enum scancommand {
+ SCAN_MARK, SCAN_DRAGTO
+};
+
+static 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 argc, char **argv,
+ Listbox *listPtr, int objc, Tcl_Obj *CONST objv[],
int flags));
-static void DeleteEls _ANSI_ARGS_((Listbox *listPtr, int first,
- int last));
+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, char *string, int endIsSize,
+ Listbox *listPtr, Tcl_Obj *index, int endIsSize,
int *indexPtr));
-static void InsertEls _ANSI_ARGS_((Listbox *listPtr, int index,
- int argc, char **argv));
+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,
@@ -294,21 +371,41 @@ static int ListboxFetchSelection _ANSI_ARGS_((
int maxBytes));
static void ListboxLostSelection _ANSI_ARGS_((
ClientData clientData));
-static void ListboxRedrawRange _ANSI_ARGS_((Listbox *listPtr,
+static void EventuallyRedrawRange _ANSI_ARGS_((Listbox *listPtr,
int first, int last));
static void ListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
int x, int y));
-static void ListboxSelect _ANSI_ARGS_((Listbox *listPtr,
+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 ListboxWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+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, char *name1, 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.
@@ -324,7 +421,7 @@ static TkClassProcs listboxClass = {
/*
*--------------------------------------------------------------
*
- * Tk_ListboxCmd --
+ * Tk_ListboxObjCmd --
*
* This procedure is invoked to process the "listbox" Tcl
* command. See the user documentation for details on what
@@ -340,25 +437,53 @@ static TkClassProcs listboxClass = {
*/
int
-Tk_ListboxCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_ListboxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register Listbox *listPtr;
- Tk_Window new;
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin;
+ ListboxOptionTables *optionTables;
+
+ optionTables = (ListboxOptionTables *)clientData;
+ if (optionTables == NULL) {
+ Tcl_CmdInfo info;
+ char *name;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) 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);
+
+ /* Store a pointer to the tables as the ClientData for the command */
+ name = Tcl_GetString(objv[0]);
+ Tcl_GetCommandInfo(interp, name, &info);
+ info.objClientData = (ClientData) optionTables;
+ Tcl_SetCommandInfo(interp, name, &info);
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
- if (new == NULL) {
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -367,55 +492,62 @@ Tk_ListboxCmd(clientData, interp, argc, argv)
* by ConfigureListbox, or that ConfigureListbox requires to be
* initialized already (e.g. resource pointers).
*/
-
- listPtr = (Listbox *) ckalloc(sizeof(Listbox));
- listPtr->tkwin = new;
- listPtr->display = Tk_Display(new);
- listPtr->interp = interp;
- listPtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(listPtr->tkwin), ListboxWidgetCmd,
+ listPtr = (Listbox *) ckalloc(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->numElements = 0;
- listPtr->firstPtr = NULL;
- listPtr->lastPtr = NULL;
- listPtr->normalBorder = NULL;
- listPtr->borderWidth = 0;
- listPtr->relief = TK_RELIEF_RAISED;
- listPtr->highlightWidth = 0;
- listPtr->highlightBgColorPtr = NULL;
- listPtr->highlightColorPtr = NULL;
- listPtr->inset = 0;
- listPtr->tkfont = NULL;
- listPtr->fgColorPtr = NULL;
- listPtr->textGC = None;
- listPtr->selBorder = NULL;
- listPtr->selBorderWidth = 0;
- listPtr->selFgColorPtr = None;
- listPtr->selTextGC = None;
- listPtr->width = 0;
- listPtr->height = 0;
- listPtr->lineHeight = 0;
- listPtr->topIndex = 0;
- listPtr->fullLines = 1;
- listPtr->partialLine = 0;
- listPtr->setGrid = 0;
- listPtr->maxWidth = 0;
- listPtr->xScrollUnit = 1;
- listPtr->xOffset = 0;
- listPtr->selectMode = NULL;
- listPtr->numSelected = 0;
- listPtr->selectAnchor = 0;
- listPtr->exportSelection = 1;
- listPtr->active = 0;
- listPtr->scanMarkX = 0;
- listPtr->scanMarkY = 0;
- listPtr->scanMarkXOffset = 0;
- listPtr->scanMarkYIndex = 0;
- listPtr->cursor = None;
- listPtr->takeFocus = NULL;
- listPtr->xScrollCmd = NULL;
- listPtr->yScrollCmd = NULL;
- listPtr->flags = 0;
+ listPtr->optionTable = optionTables->listboxOptionTable;
+ listPtr->itemAttrOptionTable = optionTables->itemAttrOptionTable;
+ listPtr->listVarName = NULL;
+ listPtr->listObj = NULL;
+ 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->nElements = 0;
+ listPtr->normalBorder = NULL;
+ listPtr->borderWidth = 0;
+ listPtr->relief = TK_RELIEF_RAISED;
+ listPtr->highlightWidth = 0;
+ listPtr->highlightBgColorPtr = NULL;
+ listPtr->highlightColorPtr = NULL;
+ listPtr->inset = 0;
+ listPtr->tkfont = NULL;
+ listPtr->fgColorPtr = NULL;
+ listPtr->textGC = None;
+ listPtr->selBorder = NULL;
+ listPtr->selBorderWidth = 0;
+ listPtr->selFgColorPtr = None;
+ listPtr->selTextGC = None;
+ listPtr->width = 0;
+ listPtr->height = 0;
+ listPtr->lineHeight = 0;
+ listPtr->topIndex = 0;
+ listPtr->fullLines = 1;
+ listPtr->partialLine = 0;
+ listPtr->setGrid = 0;
+ listPtr->maxWidth = 0;
+ listPtr->xScrollUnit = 1;
+ listPtr->xOffset = 0;
+ listPtr->selectMode = NULL;
+ listPtr->numSelected = 0;
+ listPtr->selectAnchor = 0;
+ listPtr->exportSelection = 1;
+ listPtr->active = 0;
+ listPtr->scanMarkX = 0;
+ listPtr->scanMarkY = 0;
+ listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkYIndex = 0;
+ listPtr->cursor = None;
+ listPtr->takeFocus = NULL;
+ listPtr->xScrollCmd = NULL;
+ listPtr->yScrollCmd = NULL;
+ listPtr->flags = 0;
Tk_SetClass(listPtr->tkwin, "Listbox");
TkSetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr);
@@ -424,26 +556,29 @@ Tk_ListboxCmd(clientData, interp, argc, argv)
ListboxEventProc, (ClientData) listPtr);
Tk_CreateSelHandler(listPtr->tkwin, XA_PRIMARY, XA_STRING,
ListboxFetchSelection, (ClientData) listPtr, XA_STRING);
- if (ConfigureListbox(interp, listPtr, argc-2, argv+2, 0) != TCL_OK) {
- goto error;
+ if (Tk_InitOptions(interp, (char *)listPtr,
+ optionTables->listboxOptionTable, tkwin) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
}
- interp->result = Tk_PathName(listPtr->tkwin);
- return TCL_OK;
+ if (ConfigureListbox(interp, listPtr, objc-2, objv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(listPtr->tkwin);
+ return TCL_ERROR;
+ }
- error:
- Tk_DestroyWindow(listPtr->tkwin);
- return TCL_ERROR;
+ Tcl_SetResult(interp, Tk_PathName(listPtr->tkwin), TCL_STATIC);
+ return TCL_OK;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * ListboxWidgetCmd --
+ * ListboxWidgetObjCmd --
*
- * 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.
+ * 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.
@@ -451,477 +586,804 @@ Tk_ListboxCmd(clientData, interp, argc, argv)
* Side effects:
* See the user documentation.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
static int
-ListboxWidgetCmd(clientData, interp, argc, argv)
+ListboxWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about listbox widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ 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;
- size_t length;
- int c;
- Tk_FontMetrics fm;
-
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
return TCL_ERROR;
}
- Tcl_Preserve((ClientData) listPtr);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " activate index\"",
- (char *) NULL);
- goto error;
- }
- ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index >= listPtr->numElements) {
- index = listPtr->numElements-1;
- }
- if (index < 0) {
- index = 0;
- }
- listPtr->active = index;
- ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
- } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
- int index, x, y, i;
- Element *elPtr;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " bbox index\"", (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if ((index >= listPtr->numElements) || (index < 0)) {
- goto done;
- }
- for (i = 0, elPtr = listPtr->firstPtr; i < index;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
- }
- if ((index >= listPtr->topIndex) && (index < listPtr->numElements)
- && (index < (listPtr->topIndex + listPtr->fullLines
- + listPtr->partialLine))) {
- x = listPtr->inset + listPtr->selBorderWidth - listPtr->xOffset;
- y = ((index - listPtr->topIndex)*listPtr->lineHeight)
- + listPtr->inset + listPtr->selBorderWidth;
- Tk_GetFontMetrics(listPtr->tkfont, &fm);
- sprintf(interp->result, "%d %d %d %d", x, y, elPtr->pixelWidth,
- fm.linespace);
- }
- } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
- }
- result = Tk_ConfigureValue(interp, listPtr->tkwin, configSpecs,
- (char *) listPtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
- (char *) listPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
- (char *) listPtr, argv[2], 0);
- } else {
- result = ConfigureListbox(interp, listPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 'c') && (strncmp(argv[1], "curselection", length) == 0)
- && (length >= 2)) {
- int i, count;
- char index[20];
- Element *elPtr;
+ Tcl_Preserve((ClientData)listPtr);
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " curselection\"",
- (char *) NULL);
- goto error;
- }
- count = 0;
- for (i = 0, elPtr = listPtr->firstPtr; elPtr != NULL;
- i++, elPtr = elPtr->nextPtr) {
- if (elPtr->selected) {
- sprintf(index, "%d", i);
- Tcl_AppendElement(interp, index);
- count++;
+ /*
+ * 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) {
+ Tcl_Release((ClientData)listPtr);
+ return result;
+ }
+
+ /* 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 (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;
}
- if (count != listPtr->numSelected) {
- panic("ListboxWidgetCmd: selection count incorrect");
- }
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- int first, last;
- if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " delete firstIndex ?lastIndex?\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
- goto error;
+ 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;
}
- if (first < listPtr->numElements) {
- if (argc == 3) {
- last = first;
+
+ 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 {
- if (GetListboxIndex(interp, listPtr, argv[3], 0,
- &last) != TCL_OK) {
- goto error;
+ 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 (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->numElements) {
- last = listPtr->numElements-1;
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
}
+ result = ListboxDeleteSubCmd(listPtr, first, last);
+ } else {
+ result = TCL_OK;
}
- DeleteEls(listPtr, first, last);
+ break;
}
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
- int first, last, i;
- Element *elPtr;
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " get first ?last?\"", (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
- goto error;
- }
- if ((argc == 4) && (GetListboxIndex(interp, listPtr, argv[3],
- 0, &last) != TCL_OK)) {
- goto error;
- }
- if (first >= listPtr->numElements) {
- goto done;
- }
- if (last >= listPtr->numElements) {
- last = listPtr->numElements-1;
+ 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;
}
- for (elPtr = listPtr->firstPtr, i = 0; i < first;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
+ 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;
+ }
+ result = ListboxInsertSubCmd(listPtr, index, objc-3, objv+3);
+ break;
}
- if (elPtr != NULL) {
- if (argc == 3) {
- if (first >= 0) {
- interp->result = elPtr->text;
+
+ 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 {
- for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
- Tcl_AppendElement(interp, elPtr->text);
+ 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;
}
- } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " index index\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
- != TCL_OK) {
- goto error;
- }
- sprintf(interp->result, "%d", index);
- } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " insert index ?element element ...?\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 1, &index)
- != TCL_OK) {
- goto error;
- }
- InsertEls(listPtr, index, argc-3, argv+3);
- } else if ((c == 'n') && (strncmp(argv[1], "nearest", length) == 0)) {
- int index, y;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " nearest y\"", (char *) NULL);
- goto error;
- }
- if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) {
- goto error;
- }
- index = NearestListboxElement(listPtr, y);
- sprintf(interp->result, "%d", index);
- } else if ((c == 's') && (length >= 2)
- && (strncmp(argv[1], "scan", length) == 0)) {
- int x, y;
-
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " scan mark|dragto x y\"", (char *) NULL);
- goto error;
- }
- if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)) {
- goto error;
- }
- if ((argv[2][0] == 'm')
- && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
- listPtr->scanMarkX = x;
- listPtr->scanMarkY = y;
- listPtr->scanMarkXOffset = listPtr->xOffset;
- listPtr->scanMarkYIndex = listPtr->topIndex;
- } else if ((argv[2][0] == 'd')
- && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
- ListboxScanTo(listPtr, x, y);
- } else {
- Tcl_AppendResult(interp, "bad scan option \"", argv[2],
- "\": must be mark or dragto", (char *) NULL);
- goto error;
- }
- } else if ((c == 's') && (strncmp(argv[1], "see", length) == 0)
- && (length >= 3)) {
- int index, diff;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " see index\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index >= listPtr->numElements) {
- index = listPtr->numElements-1;
- }
- if (index < 0) {
- index = 0;
- }
- diff = listPtr->topIndex-index;
- if (diff > 0) {
- if (diff <= (listPtr->fullLines/3)) {
- ChangeListboxView(listPtr, index);
- } else {
- ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2);
+
+ case COMMAND_SEE: {
+ int diff;
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "index");
+ result = TCL_ERROR;
+ break;
}
- } else {
- diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
+ 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, listPtr->topIndex + diff);
+ 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;
}
- } else if ((c == 's') && (length >= 3)
- && (strncmp(argv[1], "selection", length) == 0)) {
- int first, last;
- if ((argc != 4) && (argc != 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection option index ?index?\"",
- (char *) NULL);
- goto error;
- }
- if (GetListboxIndex(interp, listPtr, argv[3], 0, &first) != TCL_OK) {
- goto error;
+ case COMMAND_SELECTION: {
+ result = ListboxSelectionSubCmd(interp, listPtr, objc, objv);
+ break;
}
- if (argc == 5) {
- if (GetListboxIndex(interp, listPtr, argv[4], 0, &last) != TCL_OK) {
- goto error;
+
+ case COMMAND_SIZE: {
+ char buf[TCL_INTEGER_SPACE];
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ result = TCL_ERROR;
+ break;
}
- } else {
- last = first;
+ sprintf(buf, "%d", listPtr->nElements);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ result = TCL_OK;
+ break;
}
- length = strlen(argv[2]);
- c = argv[2][0];
- if ((c == 'a') && (strncmp(argv[2], "anchor", length) == 0)) {
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection anchor index\"", (char *) NULL);
- goto error;
+
+ 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->numElements) {
- first = listPtr->numElements-1;
+ if (first >= listPtr->nElements) {
+ first = listPtr->nElements - 1;
}
if (first < 0) {
first = 0;
}
listPtr->selectAnchor = first;
- } else if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
- ListboxSelect(listPtr, first, last, 0);
- } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) {
- int i;
- Element *elPtr;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " selection includes index\"", (char *) NULL);
- goto error;
- }
- if ((first < 0) || (first >= listPtr->numElements)) {
- interp->result = "0";
- goto done;
- }
- for (elPtr = listPtr->firstPtr, i = 0; i < first;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
+ 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 (elPtr->selected) {
- interp->result = "1";
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)first)) {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
} else {
- interp->result = "0";
+ Tcl_SetResult(interp, "0", TCL_STATIC);
}
- } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
- ListboxSelect(listPtr, first, last, 1);
+ 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 {
- Tcl_AppendResult(interp, "bad selection option \"", argv[2],
- "\": must be anchor, clear, includes, or set",
- (char *) NULL);
- goto error;
- }
- } else if ((c == 's') && (length >= 2)
- && (strncmp(argv[1], "size", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " size\"", (char *) NULL);
- goto error;
- }
- sprintf(interp->result, "%d", listPtr->numElements);
- } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
- int index, count, type, windowWidth, windowUnits;
- int offset = 0; /* Initialized to stop gcc warnings. */
- double fraction, fraction2;
-
- windowWidth = Tk_Width(listPtr->tkwin)
- - 2*(listPtr->inset + listPtr->selBorderWidth);
- if (argc == 2) {
- if (listPtr->maxWidth == 0) {
- interp->result = "0 1";
- } else {
- fraction = listPtr->xOffset/((double) listPtr->maxWidth);
- fraction2 = (listPtr->xOffset + windowWidth)
- /((double) listPtr->maxWidth);
- if (fraction2 > 1.0) {
- fraction2 = 1.0;
- }
- sprintf(interp->result, "%g %g", fraction, fraction2);
- }
- } else if (argc == 3) {
- if (Tcl_GetInt(interp, argv[2], &index) != TCL_OK) {
- goto error;
+ 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;
}
- ChangeListboxOffset(listPtr, index*listPtr->xScrollUnit);
- } else {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
- switch (type) {
- case TK_SCROLL_ERROR:
- goto error;
- case TK_SCROLL_MOVETO:
- offset = (int) (fraction*listPtr->maxWidth + 0.5);
- break;
- case TK_SCROLL_PAGES:
- windowUnits = windowWidth/listPtr->xScrollUnit;
- if (windowUnits > 2) {
- offset = listPtr->xOffset
- + count*listPtr->xScrollUnit*(windowUnits-2);
- } else {
- offset = listPtr->xOffset + count*listPtr->xScrollUnit;
- }
- break;
- case TK_SCROLL_UNITS:
+ 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;
- }
- ChangeListboxOffset(listPtr, offset);
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ break;
}
- } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
- int index, count, type;
- double fraction, fraction2;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- if (argc == 2) {
- if (listPtr->numElements == 0) {
- interp->result = "0 1";
- } else {
- fraction = listPtr->topIndex/((double) listPtr->numElements);
- fraction2 = (listPtr->topIndex+listPtr->fullLines)
- /((double) listPtr->numElements);
- if (fraction2 > 1.0) {
- fraction2 = 1.0;
- }
- sprintf(interp->result, "%g %g", fraction, fraction2);
- }
- } else if (argc == 3) {
- if (GetListboxIndex(interp, listPtr, argv[2], 0, &index)
- != TCL_OK) {
- goto error;
- }
- ChangeListboxView(listPtr, index);
+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 {
- type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
- switch (type) {
- case TK_SCROLL_ERROR:
- goto error;
- case TK_SCROLL_MOVETO:
- index = (int) (listPtr->numElements*fraction + 0.5);
- break;
- case TK_SCROLL_PAGES:
- if (listPtr->fullLines > 2) {
- index = listPtr->topIndex
- + count*(listPtr->fullLines-2);
- } else {
- index = listPtr->topIndex + count;
- }
- break;
- case TK_SCROLL_UNITS:
- index = listPtr->topIndex + count;
- break;
+ 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;
}
- ChangeListboxView(listPtr, index);
+ 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 {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be activate, bbox, cget, configure, ",
- "curselection, delete, get, index, insert, nearest, ",
- "scan, see, selection, size, ",
- "xview, or yview", (char *) NULL);
- goto error;
- }
- done:
- Tcl_Release((ClientData) listPtr);
- return result;
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- error:
- Tcl_Release((ClientData) listPtr);
- return TCL_ERROR;
+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;
}
/*
@@ -947,18 +1409,43 @@ DestroyListbox(memPtr)
char *memPtr; /* Info about listbox widget. */
{
register Listbox *listPtr = (Listbox *) memPtr;
- register Element *elPtr, *nextPtr;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch search;
- /*
- * Free up all of the list elements.
- */
+ listPtr->flags |= LISTBOX_DELETED;
- for (elPtr = listPtr->firstPtr; elPtr != NULL; ) {
- nextPtr = elPtr->nextPtr;
- ckfree((char *) elPtr);
- elPtr = nextPtr;
+ Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ if (listPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayListbox, (ClientData) listPtr);
}
+ /* 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
@@ -971,22 +1458,51 @@ DestroyListbox(memPtr)
if (listPtr->selTextGC != None) {
Tk_FreeGC(listPtr->display, listPtr->selTextGC);
}
- Tk_FreeOptions(configSpecs, (char *) listPtr, listPtr->display, 0);
+ Tk_FreeConfigOptions((char *)listPtr, listPtr->optionTable,
+ 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 argv/argc list, plus
+ * 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 interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, border width,
@@ -997,22 +1513,32 @@ DestroyListbox(memPtr)
*/
static int
-ConfigureListbox(interp, listPtr, argc, argv, flags)
+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 argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
+ 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;
int oldExport;
oldExport = listPtr->exportSelection;
- if (Tk_ConfigureWidget(interp, listPtr->tkwin, configSpecs,
- argc, argv, (char *) listPtr, flags) != TCL_OK) {
+ if (listPtr->listVarName != NULL) {
+ Tcl_UntraceVar(interp, listPtr->listVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ ListboxListVarProc, (ClientData) listPtr);
+ }
+
+ if (Tk_SetOptions(interp, (char *)listPtr,
+ listPtr->optionTable, objc, objv, listPtr->tkwin,
+ &savedOptions, (int *)NULL) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
return TCL_ERROR;
}
-
+
/*
* A few options need special processing, such as setting the
* background from a 3-D border.
@@ -1036,6 +1562,109 @@ ConfigureListbox(interp, listPtr, argc, argv, flags)
(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) {
+ if (listPtr->listObj != NULL) {
+ listVarObj = listPtr->listObj;
+ } else {
+ listVarObj = Tcl_NewObj();
+ }
+ if (Tcl_SetVar2Ex(interp, listPtr->listVarName, (char *)NULL,
+ listVarObj, TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DecrRefCount(listVarObj);
+ Tk_RestoreSavedOptions(&savedOptions);
+ return TCL_ERROR;
+ }
+ }
+ /* Make sure the object is a good list object */
+ if (Tcl_ListObjLength(listPtr->interp, listVarObj, &dummy) != TCL_OK) {
+ Tk_RestoreSavedOptions(&savedOptions);
+ Tcl_AppendResult(listPtr->interp, ": invalid listvar value",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ 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);
+ }
+
+ /* Make sure that the list length is correct */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
+ Tk_FreeSavedOptions(&savedOptions);
+ 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;
}
@@ -1066,15 +1695,14 @@ ListboxWorldChanged(instanceData)
GC gc;
unsigned long mask;
Listbox *listPtr;
-
+
listPtr = (Listbox *) instanceData;
gcValues.foreground = listPtr->fgColorPtr->pixel;
gcValues.font = Tk_FontId(listPtr->tkfont);
gcValues.graphics_exposures = False;
mask = GCForeground | GCFont | GCGraphicsExposures;
- gc = Tk_GetGCColor(listPtr->tkwin, mask, &gcValues, listPtr->fgColorPtr,
- NULL);
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
if (listPtr->textGC != None) {
Tk_FreeGC(listPtr->display, listPtr->textGC);
}
@@ -1083,8 +1711,7 @@ ListboxWorldChanged(instanceData)
gcValues.foreground = listPtr->selFgColorPtr->pixel;
gcValues.font = Tk_FontId(listPtr->tkfont);
mask = GCForeground | GCFont;
- gc = Tk_GetGCColor(listPtr->tkwin, mask, &gcValues, listPtr->selFgColorPtr,
- NULL);
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
if (listPtr->selTextGC != None) {
Tk_FreeGC(listPtr->display, listPtr->selTextGC);
}
@@ -1097,7 +1724,7 @@ ListboxWorldChanged(instanceData)
ListboxComputeGeometry(listPtr, 1, 1, 1);
listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
/*
@@ -1122,16 +1749,30 @@ DisplayListbox(clientData)
{
register Listbox *listPtr = (Listbox *) clientData;
register Tk_Window tkwin = listPtr->tkwin;
- register Element *elPtr;
GC gc;
int i, limit, x, y, width, prevSelected;
Tk_FontMetrics fm;
+ 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 & MAXWIDTH_IS_STALE) {
+ ListboxComputeGeometry(listPtr, 0, 1, 0);
+ listPtr->flags &= ~MAXWIDTH_IS_STALE;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+
if (listPtr->flags & UPDATE_V_SCROLLBAR) {
ListboxUpdateVScrollbar(listPtr);
}
@@ -1156,15 +1797,10 @@ DisplayListbox(clientData)
Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0,
Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
- /*
- * Iterate through all of the elements of the listbox, displaying each
- * in turn. Selected elements use a different GC and have a raised
- * background.
- */
-
+ /* Display each item in the listbox */
limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
- if (limit >= listPtr->numElements) {
- limit = listPtr->numElements-1;
+ if (limit >= listPtr->nElements) {
+ limit = listPtr->nElements-1;
}
left = right = 0;
if (listPtr->xOffset > 0) {
@@ -1175,19 +1811,45 @@ DisplayListbox(clientData)
right = listPtr->selBorderWidth+1;
}
prevSelected = 0;
- for (elPtr = listPtr->firstPtr, i = 0; (elPtr != NULL) && (i <= limit);
- prevSelected = elPtr->selected, elPtr = elPtr->nextPtr, i++) {
- if (i < listPtr->topIndex) {
- continue;
- }
+
+ for (i = listPtr->topIndex; i <= limit; i++) {
x = listPtr->inset;
y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ listPtr->inset;
gc = listPtr->textGC;
- if (elPtr->selected) {
+ /*
+ * 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 item is selected, it is drawn differently */
+ if (Tcl_FindHashEntry(listPtr->selection, (char *)i) != NULL) {
gc = listPtr->selTextGC;
width = Tk_Width(tkwin) - 2*listPtr->inset;
- Tk_Fill3DRectangle(tkwin, pixmap, listPtr->selBorder, x, y,
+ selectedBg = listPtr->selBorder;
+
+ /* If there is attribute information for this item,
+ * adjust the drawing accordingly */
+ if (entry != NULL) {
+ attrs = (ItemAttr *)Tcl_GetHashValue(entry);
+ /* The default GC has the settings 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);
+ }
+ }
+
+ Tk_Fill3DRectangle(tkwin, pixmap, selectedBg, x, y,
width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
/*
@@ -1205,43 +1867,71 @@ DisplayListbox(clientData)
* corners are off-screen.
*/
+ /* Draw left bevel */
if (left == 0) {
- Tk_3DVerticalBevel(tkwin, pixmap, listPtr->selBorder,
+ 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, listPtr->selBorder,
+ 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, listPtr->selBorder,
+ Tk_3DHorizontalBevel(tkwin, pixmap, selectedBg,
x-left, y, width+left+right, listPtr->selBorderWidth,
1, 1, 1, TK_RELIEF_RAISED);
}
- if ((elPtr->nextPtr == NULL) || !elPtr->nextPtr->selected) {
- Tk_3DHorizontalBevel(tkwin, pixmap, listPtr->selBorder, x-left,
+ /* 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 (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 (attrs->fgColor != NULL) {
+ gcValues.foreground = attrs->fgColor->pixel;
+ gc = Tk_GetGC(listPtr->tkwin, mask, &gcValues);
+ }
+ }
+ prevSelected = 0;
}
+
+ /* Draw the actual text of this item */
Tk_GetFontMetrics(listPtr->tkfont, &fm);
y += fm.ascent + listPtr->selBorderWidth;
- x = listPtr->inset + listPtr->selBorderWidth - elPtr->lBearing
- - listPtr->xOffset;
+ 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,
- elPtr->text, elPtr->textLength, x, y);
-
- /*
- * If this is the active element, underline it.
- */
+ stringRep, stringLen, x, y);
+ /* If this is the active element, underline it. */
if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont,
- elPtr->text, x, y, 0, elPtr->textLength);
+ stringRep, x, y, 0, stringLen);
}
}
@@ -1256,14 +1946,17 @@ DisplayListbox(clientData)
Tk_Height(tkwin) - 2*listPtr->highlightWidth,
listPtr->borderWidth, listPtr->relief);
if (listPtr->highlightWidth > 0) {
- GC gc;
+ GC fgGC, bgGC;
+ bgGC = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
if (listPtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
+ fgGC = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC,
+ listPtr->highlightWidth, pixmap);
} else {
- gc = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC,
+ listPtr->highlightWidth, pixmap);
}
- Tk_DrawFocusHighlight(tkwin, gc, listPtr->highlightWidth, pixmap);
}
XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin),
listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin),
@@ -1306,24 +1999,31 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
* Tk_UnsetGrid to update gridding for
* the window. */
{
- register Element *elPtr;
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 (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
- if (fontChanged) {
- elPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont,
- elPtr->text, elPtr->textLength);
- elPtr->lBearing = 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;
}
- if (elPtr->pixelWidth > listPtr->maxWidth) {
- listPtr->maxWidth = elPtr->pixelWidth;
+ text = Tcl_GetStringFromObj(element, &textLength);
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ pixelWidth = Tk_TextWidth(listPtr->tkfont, text, textLength);
+ if (pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = pixelWidth;
}
}
}
@@ -1342,7 +2042,7 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
+ 2*listPtr->selBorderWidth;
height = listPtr->height;
if (listPtr->height <= 0) {
- height = listPtr->numElements;
+ height = listPtr->nElements;
if (height < 1) {
height = 1;
}
@@ -1363,100 +2063,104 @@ ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
/*
*----------------------------------------------------------------------
*
- * InsertEls --
+ * ListboxInsertSubCmd --
*
- * Add new elements to a listbox widget.
+ * This procedure is invoked to handle the listbox "insert"
+ * subcommand.
*
* Results:
- * None.
+ * Standard Tcl result.
*
* Side effects:
- * New information gets added to listPtr; it will be redisplayed
- * soon, but not immediately.
+ * New elements are added to the listbox pointed to by listPtr;
+ * a refresh callback is registered for the listbox.
*
*----------------------------------------------------------------------
*/
-static void
-InsertEls(listPtr, index, argc, argv)
+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 argc; /* Number of new elements to add. */
- char **argv; /* New elements (one per entry). */
+ int objc; /* Number of new elements to add. */
+ Tcl_Obj *CONST objv[]; /* New elements (one per entry). */
{
- register Element *prevPtr, *newPtr;
- int length, i, oldMaxWidth;
-
- /*
- * Find the element before which the new ones will be inserted.
- */
-
- if (index <= 0) {
- index = 0;
- }
- if (index > listPtr->numElements) {
- index = listPtr->numElements;
+ 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;
+ }
}
- if (index == 0) {
- prevPtr = NULL;
- } else if (index == listPtr->numElements) {
- prevPtr = listPtr->lastPtr;
+
+ /* 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 {
- for (prevPtr = listPtr->firstPtr, i = index - 1; i > 0; i--) {
- prevPtr = prevPtr->nextPtr;
- }
+ newListObj = listPtr->listObj;
+ }
+ result =
+ Tcl_ListObjReplace(listPtr->interp, newListObj, index, 0, objc, objv);
+ if (result != TCL_OK) {
+ return result;
}
- /*
- * For each new element, create a record, initialize it, and link
- * it into the list of elements.
- */
+ Tcl_IncrRefCount(newListObj);
+ /* Clean up the old reference */
+ Tcl_DecrRefCount(listPtr->listObj);
- oldMaxWidth = listPtr->maxWidth;
- for (i = argc ; i > 0; i--, argv++, prevPtr = newPtr) {
- length = strlen(*argv);
- newPtr = (Element *) ckalloc(ElementSize(length));
- newPtr->textLength = length;
- strcpy(newPtr->text, *argv);
- newPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont, newPtr->text,
- newPtr->textLength);
- newPtr->lBearing = 0;
- if (newPtr->pixelWidth > listPtr->maxWidth) {
- listPtr->maxWidth = newPtr->pixelWidth;
- }
- newPtr->selected = 0;
- if (prevPtr == NULL) {
- newPtr->nextPtr = listPtr->firstPtr;
- listPtr->firstPtr = newPtr;
- } else {
- newPtr->nextPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = newPtr;
+ /* 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;
}
}
- if ((prevPtr != NULL) && (prevPtr->nextPtr == NULL)) {
- listPtr->lastPtr = prevPtr;
- }
- listPtr->numElements += argc;
+ /* Get the new list length */
+ Tcl_ListObjLength(listPtr->interp, listPtr->listObj, &listPtr->nElements);
+
/*
- * Update the selection and other indexes to account for the
- * renumbering that has just occurred. Then arrange for the new
+ * 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 += argc;
+ listPtr->selectAnchor += objc;
}
if (index < listPtr->topIndex) {
- listPtr->topIndex += argc;
+ listPtr->topIndex += objc;
}
if (index <= listPtr->active) {
- listPtr->active += argc;
- if ((listPtr->active >= listPtr->numElements)
- && (listPtr->numElements > 0)) {
- listPtr->active = listPtr->numElements-1;
+ listPtr->active += objc;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
}
}
listPtr->flags |= UPDATE_V_SCROLLBAR;
@@ -1464,35 +2168,42 @@ InsertEls(listPtr, index, argc, argv)
listPtr->flags |= UPDATE_H_SCROLLBAR;
}
ListboxComputeGeometry(listPtr, 0, 0, 0);
- ListboxRedrawRange(listPtr, index, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, index, listPtr->nElements-1);
+ return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * DeleteEls --
+ * ListboxDeleteSubCmd --
*
- * Remove one or more elements from a listbox widget.
+ * Process a listbox "delete" subcommand by removing one or more
+ * elements from a listbox widget.
*
* Results:
- * None.
+ * Standard Tcl result.
*
* Side effects:
- * Memory gets freed, the listbox gets modified and (eventually)
- * redisplayed.
+ * The listbox will be modified and (eventually) redisplayed.
*
*----------------------------------------------------------------------
*/
-static void
-DeleteEls(listPtr, first, last)
+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. */
{
- register Element *prevPtr, *elPtr;
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.
@@ -1501,54 +2212,85 @@ DeleteEls(listPtr, first, last)
if (first < 0) {
first = 0;
}
- if (last >= listPtr->numElements) {
- last = listPtr->numElements-1;
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements-1;
}
count = last + 1 - first;
if (count <= 0) {
- return;
+ return TCL_OK;
}
/*
- * Find the element just before the ones to delete.
+ * 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);
- if (first == 0) {
- prevPtr = NULL;
+ /* Delete the requested elements */
+ if (Tcl_IsShared(listPtr->listObj)) {
+ newListObj = Tcl_DuplicateObj(listPtr->listObj);
} else {
- for (i = first-1, prevPtr = listPtr->firstPtr; i > 0; i--) {
- prevPtr = prevPtr->nextPtr;
- }
+ newListObj = listPtr->listObj;
+ }
+ result = Tcl_ListObjReplace(listPtr->interp,
+ newListObj, first, count, 0, NULL);
+ if (result != TCL_OK) {
+ return result;
}
- /*
- * Delete the requested number of elements.
- */
+ Tcl_IncrRefCount(newListObj);
+ /* Clean up the old reference */
+ Tcl_DecrRefCount(listPtr->listObj);
- widthChanged = 0;
- for (i = count; i > 0; i--) {
- if (prevPtr == NULL) {
- elPtr = listPtr->firstPtr;
- listPtr->firstPtr = elPtr->nextPtr;
- if (listPtr->firstPtr == NULL) {
- listPtr->lastPtr = NULL;
- }
- } else {
- elPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = elPtr->nextPtr;
- if (prevPtr->nextPtr == NULL) {
- listPtr->lastPtr = prevPtr;
- }
- }
- if (elPtr->pixelWidth == listPtr->maxWidth) {
- widthChanged = 1;
- }
- if (elPtr->selected) {
- listPtr->numSelected -= 1;
+ /* 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;
}
- ckfree((char *) elPtr);
}
- listPtr->numElements -= count;
/*
* Update the selection and viewing information to reflect the change
@@ -1568,8 +2310,8 @@ DeleteEls(listPtr, first, last)
listPtr->topIndex = first;
}
}
- if (listPtr->topIndex > (listPtr->numElements - listPtr->fullLines)) {
- listPtr->topIndex = listPtr->numElements - listPtr->fullLines;
+ if (listPtr->topIndex > (listPtr->nElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->nElements - listPtr->fullLines;
if (listPtr->topIndex < 0) {
listPtr->topIndex = 0;
}
@@ -1578,9 +2320,9 @@ DeleteEls(listPtr, first, last)
listPtr->active -= count;
} else if (listPtr->active >= first) {
listPtr->active = first;
- if ((listPtr->active >= listPtr->numElements)
- && (listPtr->numElements > 0)) {
- listPtr->active = listPtr->numElements-1;
+ if ((listPtr->active >= listPtr->nElements) &&
+ (listPtr->nElements > 0)) {
+ listPtr->active = listPtr->nElements-1;
}
}
listPtr->flags |= UPDATE_V_SCROLLBAR;
@@ -1588,7 +2330,8 @@ DeleteEls(listPtr, first, last)
if (widthChanged) {
listPtr->flags |= UPDATE_H_SCROLLBAR;
}
- ListboxRedrawRange(listPtr, first, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, first, listPtr->nElements-1);
+ return TCL_OK;
}
/*
@@ -1615,24 +2358,14 @@ ListboxEventProc(clientData, eventPtr)
XEvent *eventPtr; /* Information about event. */
{
Listbox *listPtr = (Listbox *) clientData;
-
+
if (eventPtr->type == Expose) {
- ListboxRedrawRange(listPtr,
+ EventuallyRedrawRange(listPtr,
NearestListboxElement(listPtr, eventPtr->xexpose.y),
NearestListboxElement(listPtr, eventPtr->xexpose.y
+ eventPtr->xexpose.height));
} else if (eventPtr->type == DestroyNotify) {
- if (listPtr->tkwin != NULL) {
- if (listPtr->setGrid) {
- Tk_UnsetGrid(listPtr->tkwin);
- }
- listPtr->tkwin = NULL;
- Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
- }
- if (listPtr->flags & REDRAW_PENDING) {
- Tcl_CancelIdleCall(DisplayListbox, (ClientData) listPtr);
- }
- Tcl_EventuallyFree((ClientData) listPtr, DestroyListbox);
+ DestroyListbox((char *) clientData);
} else if (eventPtr->type == ConfigureNotify) {
int vertSpace;
@@ -1654,16 +2387,16 @@ ListboxEventProc(clientData, eventPtr)
* everything for safety.
*/
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
} else if (eventPtr->type == FocusIn) {
if (eventPtr->xfocus.detail != NotifyInferior) {
listPtr->flags |= GOT_FOCUS;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
} else if (eventPtr->type == FocusOut) {
if (eventPtr->xfocus.detail != NotifyInferior) {
listPtr->flags &= ~GOT_FOCUS;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
}
}
@@ -1691,7 +2424,6 @@ ListboxCmdDeletedProc(clientData)
ClientData clientData; /* Pointer to widget record for widget. */
{
Listbox *listPtr = (Listbox *) clientData;
- Tk_Window tkwin = listPtr->tkwin;
/*
* This procedure could be invoked either because the window was
@@ -1700,12 +2432,8 @@ ListboxCmdDeletedProc(clientData)
* destroys the widget.
*/
- if (tkwin != NULL) {
- if (listPtr->setGrid) {
- Tk_UnsetGrid(listPtr->tkwin);
- }
- listPtr->tkwin = NULL;
- Tk_DestroyWindow(tkwin);
+ if (!(listPtr->flags & LISTBOX_DELETED)) {
+ Tk_DestroyWindow(listPtr->tkwin);
}
}
@@ -1720,7 +2448,7 @@ ListboxCmdDeletedProc(clientData)
* Results:
* A standard Tcl result. If all went well, then *indexPtr is
* filled in with the index (into listPtr) corresponding to
- * string. Otherwise an error message is left in interp->result.
+ * string. Otherwise an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -1729,61 +2457,86 @@ ListboxCmdDeletedProc(clientData)
*/
static int
-GetListboxIndex(interp, listPtr, string, endIsSize, indexPtr)
+GetListboxIndex(interp, listPtr, indexObj, endIsSize, indexPtr)
Tcl_Interp *interp; /* For error messages. */
Listbox *listPtr; /* Listbox for which the index is being
* specified. */
- char *string; /* Specifies an element in the listbox. */
+ 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 c;
- size_t length;
-
- length = strlen(string);
- c = string[0];
- if ((c == 'a') && (strncmp(string, "active", length) == 0)
- && (length >= 2)) {
- *indexPtr = listPtr->active;
- } else if ((c == 'a') && (strncmp(string, "anchor", length) == 0)
- && (length >= 2)) {
- *indexPtr = listPtr->selectAnchor;
- } else if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
- if (endIsSize) {
- *indexPtr = listPtr->numElements;
- } else {
- *indexPtr = listPtr->numElements - 1;
- }
- } else if (c == '@') {
- int y;
- char *p, *end;
+ 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;
+ }
- p = string+1;
- strtol(p, &end, 0);
- if ((end == p) || (*end != ',')) {
- goto badIndex;
+ 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;
+ }
}
- p = end+1;
- y = strtol(p, &end, 0);
- if ((end == p) || (*end != 0)) {
- goto badIndex;
+ 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);
- } else {
- if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
- Tcl_ResetResult(interp);
- goto badIndex;
- }
+ return TCL_OK;
+ }
+
+ /* Maybe the index is just an integer */
+ if (Tcl_GetIntFromObj(interp, indexObj, indexPtr) == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
- badIndex:
- Tcl_AppendResult(interp, "bad listbox index \"", string,
- "\": must be active, anchor, end, @x,y, or a number",
- (char *) NULL);
+ /* 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;
}
@@ -1813,18 +2566,15 @@ ChangeListboxView(listPtr, index)
* that should now appear at the
* top of the listbox. */
{
- if (index >= (listPtr->numElements - listPtr->fullLines)) {
- index = listPtr->numElements - listPtr->fullLines;
+ if (index >= (listPtr->nElements - listPtr->fullLines)) {
+ index = listPtr->nElements - listPtr->fullLines;
}
if (index < 0) {
index = 0;
}
if (listPtr->topIndex != index) {
listPtr->topIndex = index;
- if (!(listPtr->flags & REDRAW_PENDING)) {
- Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
- listPtr->flags |= REDRAW_PENDING;
- }
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
listPtr->flags |= UPDATE_V_SCROLLBAR;
}
}
@@ -1853,7 +2603,7 @@ ChangeListboxOffset(listPtr, offset)
* listbox. */
{
int maxOffset;
-
+
/*
* Make sure that the new offset is within the allowable range, and
* round it off to an even multiple of xScrollUnit.
@@ -1872,7 +2622,7 @@ ChangeListboxOffset(listPtr, offset)
if (offset != listPtr->xOffset) {
listPtr->xOffset = offset;
listPtr->flags |= UPDATE_H_SCROLLBAR;
- ListboxRedrawRange(listPtr, 0, listPtr->numElements);
+ EventuallyRedrawRange(listPtr, 0, listPtr->nElements-1);
}
}
@@ -1902,8 +2652,8 @@ ListboxScanTo(listPtr, x, y)
* operation. */
{
int newTopIndex, newOffset, maxIndex, maxOffset;
-
- maxIndex = listPtr->numElements - listPtr->fullLines;
+
+ maxIndex = listPtr->nElements - listPtr->fullLines;
maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1)
- (Tk_Width(listPtr->tkwin) - 2*listPtr->inset
- 2*listPtr->selBorderWidth - listPtr->xScrollUnit);
@@ -1981,8 +2731,8 @@ NearestListboxElement(listPtr, y)
index = 0;
}
index += listPtr->topIndex;
- if (index >= listPtr->numElements) {
- index = listPtr->numElements-1;
+ if (index >= listPtr->nElements) {
+ index = listPtr->nElements-1;
}
return index;
}
@@ -1995,7 +2745,7 @@ NearestListboxElement(listPtr, y)
* Select or deselect one or more elements in a listbox..
*
* Results:
- * None.
+ * Standard Tcl result.
*
* Side effects:
* All of the elements in the range between first and last are
@@ -2007,7 +2757,7 @@ NearestListboxElement(listPtr, y)
*----------------------------------------------------------------------
*/
-static void
+static int
ListboxSelect(listPtr, first, last, select)
register Listbox *listPtr; /* Information about widget. */
int first; /* Index of first element to
@@ -2018,47 +2768,64 @@ ListboxSelect(listPtr, first, last, select)
* deselect them. */
{
int i, firstRedisplay, increment, oldCount;
- Element *elPtr;
-
+ Tcl_HashEntry *entry;
+ int new;
+
if (last < first) {
i = first;
first = last;
last = i;
}
- if ((last < 0) || (first >= listPtr->numElements)) {
- return;
+ if ((last < 0) || (first >= listPtr->nElements)) {
+ return TCL_OK;
}
if (first < 0) {
first = 0;
}
- if (last >= listPtr->numElements) {
- last = listPtr->numElements - 1;
+ if (last >= listPtr->nElements) {
+ last = listPtr->nElements - 1;
}
oldCount = listPtr->numSelected;
firstRedisplay = -1;
increment = select ? 1 : -1;
- for (i = 0, elPtr = listPtr->firstPtr; i < first;
- i++, elPtr = elPtr->nextPtr) {
- /* Empty loop body. */
- }
- for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
- if (elPtr->selected == select) {
- continue;
- }
- listPtr->numSelected += increment;
- elPtr->selected = select;
- if (firstRedisplay < 0) {
- firstRedisplay = i;
+
+ /*
+ * 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) {
- ListboxRedrawRange(listPtr, first, last);
+ EventuallyRedrawRange(listPtr, first, last);
}
if ((oldCount == 0) && (listPtr->numSelected > 0)
&& (listPtr->exportSelection)) {
Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
(ClientData) listPtr);
}
+ return TCL_OK;
}
/*
@@ -2096,10 +2863,14 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes)
* NULL character. */
{
register Listbox *listPtr = (Listbox *) clientData;
- register Element *elPtr;
Tcl_DString selection;
int length, count, needNewline;
-
+ Tcl_Obj *curElement;
+ char *stringRep;
+ int stringLen;
+ Tcl_HashEntry *entry;
+ int i;
+
if (!listPtr->exportSelection) {
return -1;
}
@@ -2110,12 +2881,16 @@ ListboxFetchSelection(clientData, offset, buffer, maxBytes)
needNewline = 0;
Tcl_DStringInit(&selection);
- for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
- if (elPtr->selected) {
+ 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_DStringAppend(&selection, elPtr->text, elPtr->textLength);
+ Tcl_ListObjIndex(listPtr->interp, listPtr->listObj, i,
+ &curElement);
+ stringRep = Tcl_GetStringFromObj(curElement, &stringLen);
+ Tcl_DStringAppend(&selection, stringRep, stringLen);
needNewline = 1;
}
}
@@ -2168,16 +2943,16 @@ ListboxLostSelection(clientData)
ClientData clientData; /* Information about listbox widget. */
{
register Listbox *listPtr = (Listbox *) clientData;
-
- if ((listPtr->exportSelection) && (listPtr->numElements > 0)) {
- ListboxSelect(listPtr, 0, listPtr->numElements-1, 0);
+
+ if ((listPtr->exportSelection) && (listPtr->nElements > 0)) {
+ ListboxSelect(listPtr, 0, listPtr->nElements-1, 0);
}
}
/*
*----------------------------------------------------------------------
*
- * ListboxRedrawRange --
+ * EventuallyRedrawRange --
*
* Ensure that a given range of elements is eventually redrawn on
* the display (if those elements in fact appear on the display).
@@ -2191,9 +2966,8 @@ ListboxLostSelection(clientData)
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
static void
-ListboxRedrawRange(listPtr, first, last)
+EventuallyRedrawRange(listPtr, first, last)
register Listbox *listPtr; /* Information about widget. */
int first; /* Index of first element in list
* that needs to be redrawn. */
@@ -2202,12 +2976,15 @@ ListboxRedrawRange(listPtr, first, last)
* be less than first;
* these just bracket a range. */
{
- if ((listPtr->tkwin == NULL) || !Tk_IsMapped(listPtr->tkwin)
- || (listPtr->flags & REDRAW_PENDING)) {
+ /* 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->tkwin == NULL)
+ || !Tk_IsMapped(listPtr->tkwin)) {
return;
}
- Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
listPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
}
/*
@@ -2234,21 +3011,21 @@ static void
ListboxUpdateVScrollbar(listPtr)
register Listbox *listPtr; /* Information about widget. */
{
- char string[100];
+ char string[TCL_DOUBLE_SPACE * 2];
double first, last;
int result;
Tcl_Interp *interp;
-
+
if (listPtr->yScrollCmd == NULL) {
return;
}
- if (listPtr->numElements == 0) {
+ if (listPtr->nElements == 0) {
first = 0.0;
last = 1.0;
} else {
- first = listPtr->topIndex/((double) listPtr->numElements);
+ first = listPtr->topIndex/((double) listPtr->nElements);
last = (listPtr->topIndex+listPtr->fullLines)
- /((double) listPtr->numElements);
+ /((double) listPtr->nElements);
if (last > 1.0) {
last = 1.0;
}
@@ -2296,7 +3073,7 @@ static void
ListboxUpdateHScrollbar(listPtr)
register Listbox *listPtr; /* Information about widget. */
{
- char string[60];
+ char string[TCL_DOUBLE_SPACE * 2];
int result, windowWidth;
double first, last;
Tcl_Interp *interp;
@@ -2335,3 +3112,174 @@ ListboxUpdateHScrollbar(listPtr)
}
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. */
+ char *name1; /* Not used. */
+ 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/tk/generic/tkMacWinMenu.c b/tk/generic/tkMacWinMenu.c
index ed9a3b1f42d..066b96eedce 100644
--- a/tk/generic/tkMacWinMenu.c
+++ b/tk/generic/tkMacWinMenu.c
@@ -14,7 +14,11 @@
#include "tkMenu.h"
-static int postCommandGeneration;
+typedef struct ThreadSpecificData {
+ int postCommandGeneration;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
static int PreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
@@ -43,6 +47,8 @@ PreprocessMenu(menuPtr)
{
int index, result, finished;
TkMenu *cascadeMenuPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_Preserve((ClientData) menuPtr);
@@ -67,16 +73,16 @@ PreprocessMenu(menuPtr)
finished = 1;
for (index = 0; index < menuPtr->numEntries; index++) {
if ((menuPtr->entries[index]->type == CASCADE_ENTRY)
- && (menuPtr->entries[index]->name != NULL)) {
+ && (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 !=
- postCommandGeneration) {
+ tsdPtr->postCommandGeneration) {
cascadeMenuPtr->postCommandGeneration =
- postCommandGeneration;
+ tsdPtr->postCommandGeneration;
result = PreprocessMenu(cascadeMenuPtr);
if (result != TCL_OK) {
goto done;
@@ -128,7 +134,11 @@ int
TkPreprocessMenu(menuPtr)
TkMenu *menuPtr;
{
- postCommandGeneration++;
- menuPtr->postCommandGeneration = postCommandGeneration;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->postCommandGeneration++;
+ menuPtr->postCommandGeneration = tsdPtr->postCommandGeneration;
return PreprocessMenu(menuPtr);
}
+
diff --git a/tk/generic/tkMain.c b/tk/generic/tkMain.c
index 02ef0afd422..9f31a9860a2 100644
--- a/tk/generic/tkMain.c
+++ b/tk/generic/tkMain.c
@@ -16,16 +16,37 @@
* RCS: @(#) $Id$
*/
+#ifdef _WIN32
+# include <windows.h>
+#endif
#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;
+Tcl_ThreadDataKey dataKey;
/*
* Declarations for various library procedures and variables (don't want
@@ -36,27 +57,14 @@
* some systems.
*/
-extern int isatty _ANSI_ARGS_((int fd));
#if !defined(__WIN32__) && !defined(_WIN32)
+extern int isatty _ANSI_ARGS_((int fd));
extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
#endif
extern void TkpDisplayWarning _ANSI_ARGS_((char *msg,
char *title));
/*
- * Global variables used by the main program:
- */
-
-static Tcl_Interp *interp; /* Interpreter for this application. */
-static Tcl_DString command; /* Used to assemble lines of terminal input
- * into Tcl commands. */
-static Tcl_DString line; /* Used to read the next line from the
- * terminal input. */
-static int tty; /* Non-zero means standard input is a
- * terminal-like device. Zero means it's
- * a file. */
-
-/*
* Forward declarations for procedures defined later in this file.
*/
@@ -67,7 +75,7 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData,
/*
*----------------------------------------------------------------------
*
- * Tk_Main --
+ * Tk_MainEx --
*
* Main program for Wish and most other Tk-based applications.
*
@@ -82,24 +90,46 @@ static void StdinProc _ANSI_ARGS_((ClientData clientData,
*
*----------------------------------------------------------------------
*/
-
void
-Tk_Main(argc, argv, appInitProc)
+Tk_MainEx(argc, argv, appInitProc, interp)
int argc; /* Number of arguments. */
char **argv; /* Array of argument strings. */
Tcl_AppInitProc *appInitProc; /* Application-specific initialization
* procedure to call after most
* initialization but before starting
* to execute commands. */
+ Tcl_Interp *interp;
{
char *args, *fileName;
- char buf[20];
+ 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]);
- interp = Tcl_CreateInterp();
+ tsdPtr->interp = interp;
+
+#if (defined(__WIN32__) || defined(MAC_TCL))
+ Tk_InitConsoleChannels(interp);
+#endif
+
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory(interp);
#endif
@@ -111,7 +141,8 @@ Tk_Main(argc, argv, appInitProc)
* use it as the name of a script file to process.
*/
- fileName = NULL;
+ fileName = TclGetStartupScriptFileName();
+
if (argc > 1) {
length = strlen(argv[1]);
if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
@@ -119,24 +150,33 @@ Tk_Main(argc, argv, appInitProc)
argv++;
}
}
- if ((argc > 1) && (argv[1][0] != '-')) {
- fileName = argv[1];
- 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, argv+1);
- Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
+ 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", (fileName != NULL) ? fileName : argv[0],
- TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
@@ -150,12 +190,31 @@ Tk_Main(argc, argv, appInitProc)
*/
#ifdef __WIN32__
- tty = 1;
+ 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
- tty = isatty(0);
+ tsdPtr->tty = isatty(0);
#endif
Tcl_SetVar(interp, "tcl_interactive",
- ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+ ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
@@ -170,6 +229,7 @@ Tk_Main(argc, argv, appInitProc)
*/
if (fileName != NULL) {
+ Tcl_ResetResult(interp);
code = Tcl_EvalFile(interp, fileName);
if (code != TCL_OK) {
/*
@@ -183,7 +243,7 @@ Tk_Main(argc, argv, appInitProc)
Tcl_DeleteInterp(interp);
Tcl_Exit(1);
}
- tty = 0;
+ tsdPtr->tty = 0;
} else {
/*
@@ -201,17 +261,18 @@ Tk_Main(argc, argv, appInitProc)
Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
(ClientData) inChannel);
}
- if (tty) {
+ if (tsdPtr->tty) {
Prompt(interp, 0);
}
}
+ Tcl_DStringFree(&argString);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (outChannel) {
Tcl_Flush(outChannel);
}
- Tcl_DStringInit(&command);
- Tcl_DStringInit(&line);
+ Tcl_DStringInit(&tsdPtr->command);
+ Tcl_DStringInit(&tsdPtr->line);
Tcl_ResetResult(interp);
/*
@@ -254,12 +315,15 @@ StdinProc(clientData, mask)
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, &line);
+ count = Tcl_Gets(chan, &tsdPtr->line);
if (count < 0) {
if (!gotPartial) {
- if (tty) {
+ if (tsdPtr->tty) {
Tcl_Exit(0);
} else {
Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
@@ -268,9 +332,10 @@ StdinProc(clientData, mask)
}
}
- (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
- cmd = Tcl_DStringAppend(&command, "\n", -1);
- Tcl_DStringFree(&line);
+ (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;
@@ -293,17 +358,14 @@ StdinProc(clientData, mask)
Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
(ClientData) chan);
}
- Tcl_DStringFree(&command);
- if (*interp->result != 0) {
- if ((code != TCL_OK) || (tty)) {
- /*
- * The statement below used to call "printf", but that resulted
- * in core dumps under Solaris 2.3 if the result was very long.
- *
- * NOTE: This probably will not work under Windows either.
- */
-
- puts(interp->result);
+ 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);
+ }
}
}
@@ -312,7 +374,7 @@ StdinProc(clientData, mask)
*/
prompt:
- if (tty) {
+ if (tsdPtr->tty) {
Prompt(interp, gotPartial);
}
Tcl_ResetResult(interp);
@@ -361,7 +423,7 @@ defaultPrompt:
outChannel = Tcl_GetChannel(interp, "stdout", NULL);
if (outChannel != (Tcl_Channel) NULL) {
- Tcl_Write(outChannel, "% ", 2);
+ Tcl_WriteChars(outChannel, "% ", 2);
}
}
} else {
@@ -377,8 +439,8 @@ defaultPrompt:
errChannel = Tcl_GetChannel(interp, "stderr", NULL);
if (errChannel != (Tcl_Channel) NULL) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
goto defaultPrompt;
}
@@ -388,3 +450,5 @@ defaultPrompt:
Tcl_Flush(outChannel);
}
}
+
+
diff --git a/tk/generic/tkMenu.c b/tk/generic/tkMenu.c
index 3663d40ecbc..2e84ebb59eb 100644
--- a/tk/generic/tkMenu.c
+++ b/tk/generic/tkMenu.c
@@ -7,7 +7,7 @@
* and drawing code for menus is in the file tkMenuDraw.c
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * 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.
@@ -68,174 +68,247 @@
*
*/
+#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"
-static int menusInitialized; /* Whether or not the hash tables, etc., have
- * been setup */
+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.
*/
-Tk_ConfigSpec tkMenuEntryConfigSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorder),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ACTIVE_FG, Tk_Offset(TkMenuEntry, activeFg),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-accelerator", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ACCELERATOR, Tk_Offset(TkMenuEntry, accel),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_BG, Tk_Offset(TkMenuEntry, border),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |SEPARATOR_MASK|TEAROFF_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_BITMAP, Tk_Offset(TkMenuEntry, bitmap),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_COLUMN_BREAK, Tk_Offset(TkMenuEntry, columnBreak),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
- {TK_CONFIG_STRING, "-command", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_COMMAND, Tk_Offset(TkMenuEntry, command),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_FONT, Tk_Offset(TkMenuEntry, tkfont),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_FG, Tk_Offset(TkMenuEntry, fg),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_HIDE_MARGIN, Tk_Offset(TkMenuEntry, hideMargin),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |SEPARATOR_MASK|TEAROFF_MASK},
- {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_IMAGE, Tk_Offset(TkMenuEntry, imageString),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_INDICATOR, Tk_Offset(TkMenuEntry, indicatorOn),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_LABEL, Tk_Offset(TkMenuEntry, label),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK},
- {TK_CONFIG_STRING, "-menu", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name),
- CASCADE_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-offvalue", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_OFF_VALUE, Tk_Offset(TkMenuEntry, offValue),
- CHECK_BUTTON_MASK},
- {TK_CONFIG_STRING, "-onvalue", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_ON_VALUE, Tk_Offset(TkMenuEntry, onValue),
- CHECK_BUTTON_MASK},
- {TK_CONFIG_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_SELECT, Tk_Offset(TkMenuEntry, indicatorFg),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-selectimage", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_SELECT_IMAGE, Tk_Offset(TkMenuEntry, selectImageString),
- CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-state", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_STATE, Tk_Offset(TkMenuEntry, state),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TEAROFF_MASK|TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_STRING, "-value", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_VALUE, Tk_Offset(TkMenuEntry, onValue),
- RADIO_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_CHECK_VARIABLE, Tk_Offset(TkMenuEntry, name),
- CHECK_BUTTON_MASK|TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-variable", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_RADIO_VARIABLE, Tk_Offset(TkMenuEntry, name),
- RADIO_BUTTON_MASK},
- {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL,
- DEF_MENU_ENTRY_UNDERLINE, Tk_Offset(TkMenuEntry, underline),
- COMMAND_MASK|CHECK_BUTTON_MASK|RADIO_BUTTON_MASK|CASCADE_MASK
- |TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+char *tkMenuStateStrings[] = {"active", "normal", "disabled", (char *) NULL};
+
+static char *menuEntryTypeStrings[] = {"cascade", "checkbutton", "command",
+ "radiobutton", "separator", (char *) NULL};
+
+Tk_OptionSpec tkBasicMenuEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_BG, Tk_Offset(TkMenuEntry, activeBorderPtr), -1,
+ TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-activeforeground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACTIVE_FG,
+ Tk_Offset(TkMenuEntry, activeFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-accelerator", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ACCELERATOR,
+ Tk_Offset(TkMenuEntry, accelPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BITMAP,
+ Tk_Offset(TkMenuEntry, bitmapPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-columnbreak", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COLUMN_BREAK,
+ -1, Tk_Offset(TkMenuEntry, columnBreak)},
+ {TK_OPTION_STRING, "-command", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_COMMAND,
+ Tk_Offset(TkMenuEntry, commandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_FONT, "-font", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FONT,
+ Tk_Offset(TkMenuEntry, fontPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_FG,
+ Tk_Offset(TkMenuEntry, fgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-hidemargin", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_HIDE_MARGIN,
+ -1, Tk_Offset(TkMenuEntry, hideMargin)},
+ {TK_OPTION_STRING, "-image", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_IMAGE,
+ Tk_Offset(TkMenuEntry, imagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-label", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_LABEL,
+ Tk_Offset(TkMenuEntry, labelPtr), -1, 0},
+ {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE,
+ -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) tkMenuStateStrings},
+ {TK_OPTION_INT, "-underline", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_UNDERLINE, -1, Tk_Offset(TkMenuEntry, underline)},
+ {TK_OPTION_END}
+};
+
+Tk_OptionSpec tkSeparatorEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END}
+};
+
+Tk_OptionSpec tkCheckButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn)},
+ {TK_OPTION_STRING, "-offvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_OFF_VALUE,
+ Tk_Offset(TkMenuEntry, offValuePtr), -1},
+ {TK_OPTION_STRING, "-onvalue", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_ON_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1},
+ {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_CHECK_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkRadioButtonEntryConfigSpecs[] = {
+ {TK_OPTION_BOOLEAN, "-indicatoron", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_INDICATOR,
+ -1, Tk_Offset(TkMenuEntry, indicatorOn)},
+ {TK_OPTION_COLOR, "-selectcolor", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT,
+ Tk_Offset(TkMenuEntry, indicatorFgPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-selectimage", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_SELECT_IMAGE,
+ Tk_Offset(TkMenuEntry, selectImagePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-value", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_VALUE,
+ Tk_Offset(TkMenuEntry, onValuePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-variable", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_RADIO_VARIABLE,
+ Tk_Offset(TkMenuEntry, namePtr), -1, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
};
+Tk_OptionSpec tkCascadeEntryConfigSpecs[] = {
+ {TK_OPTION_STRING, "-menu", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_MENU,
+ Tk_Offset(TkMenuEntry, namePtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) tkBasicMenuEntryConfigSpecs}
+};
+
+Tk_OptionSpec tkTearoffEntryConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-background", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_BG,
+ Tk_Offset(TkMenuEntry, borderPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-state", (char *) NULL, (char *) NULL,
+ DEF_MENU_ENTRY_STATE, -1, Tk_Offset(TkMenuEntry, state), 0,
+ (ClientData) tkMenuStateStrings},
+ {TK_OPTION_END}
+};
+
+static Tk_OptionSpec *specsArray[] = {
+ tkCascadeEntryConfigSpecs, tkCheckButtonEntryConfigSpecs,
+ tkBasicMenuEntryConfigSpecs, tkRadioButtonEntryConfigSpecs,
+ tkSeparatorEntryConfigSpecs, tkTearoffEntryConfigSpecs};
+
/*
- * Configuration specs valid for the menu as a whole. If this changes, be sure
- * to update code in TkpMenuInit that changes the font string entry.
+ * Menu type strings for use with Tcl_GetIndexFromObj.
*/
-Tk_ConfigSpec tkMenuConfigSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_MENU_ACTIVE_BG_COLOR, Tk_Offset(TkMenu, activeBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_MENU_ACTIVE_BG_MONO, Tk_Offset(TkMenu, activeBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_PIXELS, "-activeborderwidth", "activeBorderWidth",
+static char *menuTypeStrings[] = {"normal", "tearoff", "menubar",
+ (char *) NULL};
+
+Tk_OptionSpec tkMenuConfigSpecs[] = {
+ {TK_OPTION_BORDER, "-activebackground", "activeBackground",
+ "Foreground", DEF_MENU_ACTIVE_BG_COLOR,
+ Tk_Offset(TkMenu, activeBorderPtr), -1, 0,
+ (ClientData) DEF_MENU_ACTIVE_BG_MONO},
+ {TK_OPTION_PIXELS, "-activeborderwidth", "activeBorderWidth",
"BorderWidth", DEF_MENU_ACTIVE_BORDER_WIDTH,
- Tk_Offset(TkMenu, activeBorderWidth), 0},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_MENU_ACTIVE_FG_COLOR, Tk_Offset(TkMenu, activeFg),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_MENU_ACTIVE_FG_MONO, Tk_Offset(TkMenu, activeFg),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_MENU_BG_COLOR, Tk_Offset(TkMenu, border), TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_MENU_BG_MONO, Tk_Offset(TkMenu, border), TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_MENU_BORDER_WIDTH, Tk_Offset(TkMenu, borderWidth), 0},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_MENU_CURSOR, Tk_Offset(TkMenu, cursor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ 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, disabledFg), TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
- "DisabledForeground", DEF_MENU_DISABLED_FG_MONO,
- Tk_Offset(TkMenu, disabledFg), TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0},
- {TK_CONFIG_STRING, "-postcommand", "postCommand", "Command",
- DEF_MENU_POST_COMMAND, Tk_Offset(TkMenu, postCommand),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_MENU_RELIEF, Tk_Offset(TkMenu, relief), 0},
- {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
- DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFg),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-selectcolor", "selectColor", "Background",
- DEF_MENU_SELECT_MONO, Tk_Offset(TkMenu, indicatorFg),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_MENU_TAKE_FOCUS, Tk_Offset(TkMenu, takeFocus), TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-tearoff", "tearOff", "TearOff",
- DEF_MENU_TEAROFF, Tk_Offset(TkMenu, tearOff), 0},
- {TK_CONFIG_STRING, "-tearoffcommand", "tearOffCommand", "TearOffCommand",
- DEF_MENU_TEAROFF_CMD, Tk_Offset(TkMenu, tearOffCommand),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-title", "title", "Title",
- DEF_MENU_TITLE, Tk_Offset(TkMenu, title), TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-type", "type", "Type",
- DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypeName), TK_CONFIG_NULL_OK},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+ Tk_Offset(TkMenu, disabledFgPtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) DEF_MENU_DISABLED_FG_MONO},
+ {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
+ {TK_OPTION_FONT, "-font", "font", "Font",
+ DEF_MENU_FONT, Tk_Offset(TkMenu, fontPtr), -1},
+ {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MENU_FG, Tk_Offset(TkMenu, fgPtr), -1},
+ {TK_OPTION_STRING, "-postcommand", "postCommand", "Command",
+ DEF_MENU_POST_COMMAND,
+ Tk_Offset(TkMenu, postCommandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENU_RELIEF, Tk_Offset(TkMenu, reliefPtr), -1},
+ {TK_OPTION_COLOR, "-selectcolor", "selectColor", "Background",
+ DEF_MENU_SELECT_COLOR, Tk_Offset(TkMenu, indicatorFgPtr), -1, 0,
+ (ClientData) DEF_MENU_SELECT_MONO},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENU_TAKE_FOCUS,
+ Tk_Offset(TkMenu, takeFocusPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_BOOLEAN, "-tearoff", "tearOff", "TearOff",
+ DEF_MENU_TEAROFF, -1, Tk_Offset(TkMenu, tearoff)},
+ {TK_OPTION_STRING, "-tearoffcommand", "tearOffCommand",
+ "TearOffCommand", DEF_MENU_TEAROFF_CMD,
+ Tk_Offset(TkMenu, tearoffCommandPtr), -1, TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING, "-title", "title", "Title",
+ DEF_MENU_TITLE, Tk_Offset(TkMenu, titlePtr), -1,
+ TK_OPTION_NULL_OK},
+ {TK_OPTION_STRING_TABLE, "-type", "type", "Type",
+ DEF_MENU_TYPE, Tk_Offset(TkMenu, menuTypePtr), -1, TK_OPTION_NULL_OK,
+ (ClientData) menuTypeStrings},
+ {TK_OPTION_END}
+};
+
+/*
+ * Command line options. Put here because MenuCmd has to look at them
+ * along with MenuWidgetObjCmd.
+ */
+
+static char *menuOptions[] = {
+ "activate", "add", "cget", "clone", "configure", "delete", "entrycget",
+ "entryconfigure", "index", "insert", "invoke", "post", "postcascade",
+ "type", "unpost", "yposition", (char *) NULL
+};
+enum options {
+ MENU_ACTIVATE, MENU_ADD, MENU_CGET, MENU_CLONE, MENU_CONFIGURE,
+ MENU_DELETE, MENU_ENTRYCGET, MENU_ENTRYCONFIGURE, MENU_INDEX,
+ MENU_INSERT, MENU_INVOKE, MENU_POST, MENU_POSTCASCADE, MENU_TYPE,
+ MENU_UNPOST, MENU_YPOSITION
};
/*
@@ -243,15 +316,14 @@ Tk_ConfigSpec tkMenuConfigSpecs[] = {
*/
static int CloneMenu _ANSI_ARGS_((TkMenu *menuPtr,
- char *newMenuName, char *newMenuTypeString));
+ Tcl_Obj *newMenuName, Tcl_Obj *newMenuTypeString));
static int ConfigureMenu _ANSI_ARGS_((Tcl_Interp *interp,
- TkMenu *menuPtr, int argc, char **argv,
- int flags));
+ TkMenu *menuPtr, int objc, Tcl_Obj *CONST objv[]));
static int ConfigureMenuCloneEntries _ANSI_ARGS_((
Tcl_Interp *interp, TkMenu *menuPtr, int index,
- int argc, char **argv, int flags));
+ int objc, Tcl_Obj *CONST objv[]));
static int ConfigureMenuEntry _ANSI_ARGS_((TkMenuEntry *mePtr,
- int argc, char **argv, int flags));
+ int objc, Tcl_Obj *CONST objv[]));
static void DeleteMenuCloneEntries _ANSI_ARGS_((TkMenu *menuPtr,
int first, int last));
static void DestroyMenuHashTable _ANSI_ARGS_((
@@ -262,10 +334,13 @@ static int GetIndexFromCoords
_ANSI_ARGS_((Tcl_Interp *interp, TkMenu *menuPtr,
char *string, int *indexPtr));
static int MenuDoYPosition _ANSI_ARGS_((Tcl_Interp *interp,
- TkMenu *menuPtr, char *arg));
+ TkMenu *menuPtr, Tcl_Obj *objPtr));
static int MenuAddOrInsert _ANSI_ARGS_((Tcl_Interp *interp,
- TkMenu *menuPtr, char *indexString, int argc,
- char **argv));
+ 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,
@@ -273,10 +348,12 @@ static TkMenuEntry * MenuNewEntry _ANSI_ARGS_((TkMenu *menuPtr, int index,
static char * MenuVarProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-static int MenuWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static 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));
@@ -290,13 +367,61 @@ static TkClassProcs menuClass = {
NULL, /* createProc. */
MenuWorldChanged /* geometryProc. */
};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateMenuCmd --
+ *
+ * Called by Tk at initialization time to create the menu
+ * command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+TkCreateMenuCmd(interp)
+ Tcl_Interp *interp; /* Interpreter we are creating the
+ * command in. */
+{
+ TkMenuOptionTables *optionTablesPtr =
+ (TkMenuOptionTables *) ckalloc(sizeof(TkMenuOptionTables));
+
+ optionTablesPtr->menuOptionTable =
+ Tk_CreateOptionTable(interp, tkMenuConfigSpecs);
+ optionTablesPtr->entryOptionTables[TEAROFF_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[TEAROFF_ENTRY]);
+ optionTablesPtr->entryOptionTables[COMMAND_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[COMMAND_ENTRY]);
+ optionTablesPtr->entryOptionTables[CASCADE_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[CASCADE_ENTRY]);
+ optionTablesPtr->entryOptionTables[SEPARATOR_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[SEPARATOR_ENTRY]);
+ optionTablesPtr->entryOptionTables[RADIO_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[RADIO_BUTTON_ENTRY]);
+ optionTablesPtr->entryOptionTables[CHECK_BUTTON_ENTRY] =
+ Tk_CreateOptionTable(interp, specsArray[CHECK_BUTTON_ENTRY]);
+
+ Tcl_CreateObjCommand(interp, "menu", MenuCmd,
+ (ClientData) optionTablesPtr, NULL);
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "menu", "menu");
+ }
+ return TCL_OK;
+}
/*
*--------------------------------------------------------------
*
- * Tk_MenuCmd --
+ * MenuCmd --
*
* This procedure is invoked to process the "menu" Tcl
* command. See the user documentation for details on
@@ -311,48 +436,45 @@ static TkClassProcs menuClass = {
*--------------------------------------------------------------
*/
-int
-Tk_MenuCmd(clientData, interp, argc, argv)
+static int
+MenuCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window tkwin = Tk_MainWindow(interp);
Tk_Window new;
register TkMenu *menuPtr;
TkMenuReferences *menuRefPtr;
- int i, len;
- char *arg, c;
+ int i, index;
int toplevel;
+ char *windowName;
+ static char *typeStringList[] = {"-type", (char *) NULL};
+ TkMenuOptionTables *optionTablesPtr = (TkMenuOptionTables *) clientData;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
TkMenuInit();
toplevel = 1;
- for (i = 2; i < argc; i += 2) {
- arg = argv[i];
- len = strlen(arg);
- if (len < 2) {
- continue;
- }
- c = arg[1];
- if ((c == 't') && (strncmp(arg, "-type", strlen(arg)) == 0)
- && (len >= 3)) {
- if (strcmp(argv[i + 1], "menubar") == 0) {
+ 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;
}
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], toplevel ? ""
+ windowName = Tcl_GetStringFromObj(objv[1], NULL);
+ new = Tk_CreateWindowFromPath(interp, tkwin, windowName, toplevel ? ""
: NULL);
if (new == NULL) {
return TCL_ERROR;
@@ -366,27 +488,27 @@ Tk_MenuCmd(clientData, interp, argc, argv)
menuPtr->tkwin = new;
menuPtr->display = Tk_Display(new);
menuPtr->interp = interp;
- menuPtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(menuPtr->tkwin), MenuWidgetCmd,
+ menuPtr->widgetCmd = Tcl_CreateObjCommand(interp,
+ Tk_PathName(menuPtr->tkwin), MenuWidgetObjCmd,
(ClientData) menuPtr, MenuCmdDeletedProc);
menuPtr->entries = NULL;
menuPtr->numEntries = 0;
menuPtr->active = -1;
- menuPtr->border = NULL;
- menuPtr->borderWidth = 0;
- menuPtr->relief = TK_RELIEF_FLAT;
- menuPtr->activeBorder = NULL;
- menuPtr->activeBorderWidth = 0;
- menuPtr->tkfont = NULL;
- menuPtr->fg = NULL;
- menuPtr->disabledFg = NULL;
- menuPtr->activeFg = NULL;
- menuPtr->indicatorFg = NULL;
- menuPtr->tearOff = 1;
- menuPtr->tearOffCommand = NULL;
- menuPtr->cursor = None;
- menuPtr->takeFocus = NULL;
- menuPtr->postCommand = NULL;
+ menuPtr->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;
@@ -394,24 +516,38 @@ Tk_MenuCmd(clientData, interp, argc, argv)
menuPtr->menuType = UNKNOWN_TYPE;
menuPtr->menuFlags = 0;
menuPtr->parentTopLevelPtr = NULL;
- menuPtr->menuTypeName = NULL;
- menuPtr->title = NULL;
+ menuPtr->menuTypePtr = NULL;
+ menuPtr->titlePtr = NULL;
+ menuPtr->errorStructPtr = NULL;
+ menuPtr->optionTablesPtr = optionTablesPtr;
TkMenuInitializeDrawingFields(menuPtr);
+ Tk_SetClass(menuPtr->tkwin, "Menu");
+ TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
+ if (Tk_InitOptions(interp, (char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin)
+ != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ ckfree((char *) menuPtr);
+ return TCL_ERROR;
+ }
+
+
menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
Tk_PathName(menuPtr->tkwin));
menuRefPtr->menuPtr = menuPtr;
menuPtr->menuRefPtr = menuRefPtr;
if (TCL_OK != TkpNewMenu(menuPtr)) {
- goto error;
+ Tk_DestroyWindow(menuPtr->tkwin);
+ ckfree((char *) menuPtr);
+ return TCL_ERROR;
}
- Tk_SetClass(menuPtr->tkwin, "Menu");
- TkSetClassProcs(menuPtr->tkwin, &menuClass, (ClientData) menuPtr);
Tk_CreateEventHandler(new, ExposureMask|StructureNotifyMask|ActivateMask,
TkMenuEventProc, (ClientData) menuPtr);
- if (ConfigureMenu(interp, menuPtr, argc-2, argv+2, 0) != TCL_OK) {
- goto error;
+ if (ConfigureMenu(interp, menuPtr, objc - 2, objv + 2) != TCL_OK) {
+ Tk_DestroyWindow(menuPtr->tkwin);
+ return TCL_ERROR;
}
/*
@@ -434,8 +570,8 @@ Tk_MenuCmd(clientData, interp, argc, argv)
if (menuRefPtr->parentEntryPtr != NULL) {
TkMenuEntry *cascadeListPtr = menuRefPtr->parentEntryPtr;
TkMenuEntry *nextCascadePtr;
- char *newMenuName;
- char *newArgv[2];
+ Tcl_Obj *newMenuName;
+ Tcl_Obj *newObjv[2];
while (cascadeListPtr != NULL) {
@@ -454,28 +590,38 @@ Tk_MenuCmd(clientData, interp, argc, argv)
|| ((menuPtr->masterMenuPtr == menuPtr)
&& ((cascadeListPtr->menuPtr->masterMenuPtr
== cascadeListPtr->menuPtr)))) {
- newArgv[0] = "-menu";
- newArgv[1] = Tk_PathName(menuPtr->tkwin);
- ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
- TK_CONFIG_ARGV_ONLY);
+ 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,
- Tk_PathName(cascadeListPtr->menuPtr->tkwin),
- menuPtr);
- CloneMenu(menuPtr, newMenuName, "normal");
+ 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.
*/
- newArgv[0] = "-menu";
- newArgv[1] = newMenuName;
- ConfigureMenuEntry(cascadeListPtr, 2, newArgv,
- TK_CONFIG_ARGV_ONLY);
- if (newMenuName != NULL) {
- ckfree(newMenuName);
- }
+ 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;
}
@@ -507,18 +653,14 @@ Tk_MenuCmd(clientData, interp, argc, argv)
}
}
- interp->result = Tk_PathName(menuPtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(menuPtr->tkwin), TCL_STATIC);
return TCL_OK;
-
- error:
- Tk_DestroyWindow(menuPtr->tkwin);
- return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
- * MenuWidgetCmd --
+ * MenuWidgetObjCmd --
*
* This procedure is invoked to process the Tcl command
* that corresponds to a widget managed by this module.
@@ -534,317 +676,353 @@ Tk_MenuCmd(clientData, interp, argc, argv)
*/
static int
-MenuWidgetCmd(clientData, interp, argc, argv)
+MenuWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about menu widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
register TkMenu *menuPtr = (TkMenu *) clientData;
register TkMenuEntry *mePtr;
int result = TCL_OK;
- size_t length;
- int c;
+ int option;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ 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);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)
- && (length >= 2)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " activate index\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (menuPtr->active == index) {
- goto done;
- }
- if (index >= 0) {
- if ((menuPtr->entries[index]->type == SEPARATOR_ENTRY)
- || (menuPtr->entries[index]->state == tkDisabledUid)) {
+
+ switch ((enum options) option) {
+ case MENU_ACTIVATE: {
+ int index;
+ /* patch for menu selection */
+ int state;
+
+ 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;
}
- result = TkActivateMenuEntry(menuPtr, index);
- } else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)
- && (length >= 2)) {
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " add type ?options?\"", (char *) NULL);
- goto error;
+ 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;
}
- if (MenuAddOrInsert(interp, menuPtr, (char *) NULL,
- argc-2, argv+2) != TCL_OK) {
- goto error;
+ 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;
}
- } 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;
+ 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;
}
- result = Tk_ConfigureValue(interp, menuPtr->tkwin, tkMenuConfigSpecs,
- (char *) menuPtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "clone", length) == 0)
- && (length >=2)) {
- if ((argc < 3) || (argc > 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " clone newMenuName ?menuType?\"",
- (char *) NULL);
- goto error;
- }
- result = CloneMenu(menuPtr, argv[2], (argc == 3) ? NULL : argv[3]);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuConfigSpecs, (char *) menuPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuConfigSpecs, (char *) menuPtr, argv[2], 0);
- } else {
- result = ConfigureMenu(interp, menuPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
+ 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;
}
- } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
- int first, last;
+ case MENU_ENTRYCONFIGURE: {
+ int index;
+ Tcl_Obj *resultPtr;
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " delete first ?last?\"", (char *) NULL);
- goto error;
+ 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;
}
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &first) != TCL_OK) {
- goto error;
+ 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;
}
- if (argc == 3) {
- last = first;
- } else {
- if (TkGetMenuIndex(interp, menuPtr, argv[3], 0, &last) != TCL_OK) {
- goto error;
+ 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;
}
- if (menuPtr->tearOff && (first == 0)) {
+ 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;
+ }
/*
- * Sorry, can't delete the tearoff entry; must reconfigure
- * the menu.
+ * 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.
*/
- first = 1;
- }
- if ((first < 0) || (last < first)) {
- goto done;
- }
- DeleteMenuCloneEntries(menuPtr, first, last);
- } else if ((c == 'e') && (length >= 7)
- && (strncmp(argv[1], "entrycget", length) == 0)) {
- int index;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " entrycget index option\"",
- (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- mePtr = menuPtr->entries[index];
- Tcl_Preserve((ClientData) mePtr);
- result = Tk_ConfigureValue(interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
- COMMAND_MASK << mePtr->type);
- Tcl_Release((ClientData) mePtr);
- } else if ((c == 'e') && (length >= 7)
- && (strncmp(argv[1], "entryconfigure", length) == 0)) {
- int index;
-
- if (argc < 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " entryconfigure index ?option value ...?\"",
- (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- mePtr = menuPtr->entries[index];
- Tcl_Preserve((ClientData) mePtr);
- if (argc == 3) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, (char *) mePtr, (char *) NULL,
- COMMAND_MASK << mePtr->type);
- } else if (argc == 4) {
- result = Tk_ConfigureInfo(interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, (char *) mePtr, argv[3],
- COMMAND_MASK << mePtr->type);
- } else {
- result = ConfigureMenuCloneEntries(interp, menuPtr, index,
- argc-3, argv+3,
- TK_CONFIG_ARGV_ONLY | COMMAND_MASK << mePtr->type);
- }
- Tcl_Release((ClientData) mePtr);
- } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
- && (length >= 3)) {
- int index;
-
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " index string\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- interp->result = "none";
- } else {
- sprintf(interp->result, "%d", index);
- }
- } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
- && (length >= 3)) {
- if (argc < 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " insert index type ?options?\"", (char *) NULL);
- goto error;
- }
- if (MenuAddOrInsert(interp, menuPtr, argv[2],
- argc-3, argv+3) != TCL_OK) {
- goto error;
+ if (menuPtr->menuType != TEAROFF_MENU) {
+ result = TkpPostMenu(interp, menuPtr, x, y);
+ } else {
+ result = TkPostTearoffMenu(interp, menuPtr, x, y);
+ }
+ break;
}
- } else if ((c == 'i') && (strncmp(argv[1], "invoke", length) == 0)
- && (length >= 3)) {
- int index;
+ case MENU_POSTCASCADE: {
+ int index;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " invoke index\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- result = TkInvokeMenu(interp, menuPtr, index);
- } else if ((c == 'p') && (strncmp(argv[1], "post", length) == 0)
- && (length == 4)) {
- int x, y;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " post x y\"", (char *) NULL);
- goto error;
- }
- if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
- goto error;
- }
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "postcascade index");
+ goto error;
+ }
- /*
- * Tearoff menus are posted differently on Mac and Windows than
- * non-tearoffs. TkpPostMenu does not actually map the menu's
- * window on those platforms, and popup menus have to be
- * handled specially.
- */
-
- if (menuPtr->menuType != TEAROFF_MENU) {
- result = TkpPostMenu(interp, menuPtr, x, y);
- } else {
- result = TkPostTearoffMenu(interp, menuPtr, x, y);
- }
- } else if ((c == 'p') && (strncmp(argv[1], "postcascade", length) == 0)
- && (length > 4)) {
- int index;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " postcascade index\"", (char *) NULL);
- goto error;
+ if (TkGetMenuIndex(interp, menuPtr, 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;
}
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
+ case MENU_TYPE: {
+ int index;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "type index");
+ goto error;
+ }
+ if (TkGetMenuIndex(interp, menuPtr, objv[2], 0, &index)
+ != TCL_OK) {
+ goto error;
+ }
+ if (index < 0) {
+ goto done;
+ }
+ if (menuPtr->entries[index]->type == TEAROFF_ENTRY) {
+ Tcl_SetResult(interp, "tearoff", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp,
+ menuEntryTypeStrings[menuPtr->entries[index]->type],
+ TCL_STATIC);
+ }
+ break;
}
- if ((index < 0) || (menuPtr->entries[index]->type != CASCADE_ENTRY)) {
+ case MENU_UNPOST:
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "unpost");
+ goto error;
+ }
+ Tk_UnmapWindow(menuPtr->tkwin);
result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
- } else {
- result = TkPostSubmenu(interp, menuPtr, menuPtr->entries[index]);
- }
- } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
- int index;
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " type index\"", (char *) NULL);
- goto error;
- }
- if (TkGetMenuIndex(interp, menuPtr, argv[2], 0, &index) != TCL_OK) {
- goto error;
- }
- if (index < 0) {
- goto done;
- }
- mePtr = menuPtr->entries[index];
- switch (mePtr->type) {
- case COMMAND_ENTRY:
- interp->result = "command";
- break;
- case SEPARATOR_ENTRY:
- interp->result = "separator";
- break;
- case CHECK_BUTTON_ENTRY:
- interp->result = "checkbutton";
- break;
- case RADIO_BUTTON_ENTRY:
- interp->result = "radiobutton";
- break;
- case CASCADE_ENTRY:
- interp->result = "cascade";
- break;
- case TEAROFF_ENTRY:
- interp->result = "tearoff";
- break;
- }
- } else if ((c == 'u') && (strncmp(argv[1], "unpost", length) == 0)) {
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " unpost\"", (char *) NULL);
- goto error;
- }
- Tk_UnmapWindow(menuPtr->tkwin);
- result = TkPostSubmenu(interp, menuPtr, (TkMenuEntry *) NULL);
- } else if ((c == 'y') && (strncmp(argv[1], "yposition", length) == 0)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " yposition index\"", (char *) NULL);
- goto error;
- }
- result = MenuDoYPosition(interp, menuPtr, argv[2]);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be activate, add, cget, clone, configure, delete, ",
- "entrycget, entryconfigure, index, insert, invoke, ",
- "post, postcascade, type, unpost, or yposition",
- (char *) NULL);
- goto error;
+ 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);
@@ -854,7 +1032,6 @@ MenuWidgetCmd(clientData, interp, argc, argv)
Tcl_Release((ClientData) menuPtr);
return TCL_ERROR;
}
-
/*
*----------------------------------------------------------------------
@@ -888,45 +1065,60 @@ TkInvokeMenu(interp, menuPtr, index)
goto done;
}
mePtr = menuPtr->entries[index];
- if (mePtr->state == tkDisabledUid) {
+ if (mePtr->state == ENTRY_DISABLED) {
goto done;
}
Tcl_Preserve((ClientData) mePtr);
if (mePtr->type == TEAROFF_ENTRY) {
- Tcl_DString commandDString;
-
- Tcl_DStringInit(&commandDString);
- Tcl_DStringAppendElement(&commandDString, "tkTearOffMenu");
- Tcl_DStringAppendElement(&commandDString, Tk_PathName(menuPtr->tkwin));
- result = Tcl_Eval(interp, Tcl_DStringValue(&commandDString));
- Tcl_DStringFree(&commandDString);
- } else if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "tkTearOffMenu ", -1);
+ Tcl_DStringAppend(&ds, Tk_PathName(menuPtr->tkwin), -1);
+ result = Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ } else if ((mePtr->type == CHECK_BUTTON_ENTRY)
+ && (mePtr->namePtr != NULL)) {
+ Tcl_Obj *valuePtr;
+
if (mePtr->entryFlags & ENTRY_SELECTED) {
- if (Tcl_SetVar(interp, mePtr->name, mePtr->offValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- }
+ valuePtr = mePtr->offValuePtr;
} else {
- if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
- TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- }
+ 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();
}
- } else if (mePtr->type == RADIO_BUTTON_ENTRY) {
- if (Tcl_SetVar(interp, mePtr->name, mePtr->onValue,
+ Tcl_IncrRefCount(valuePtr);
+ if (Tcl_ObjSetVar2(interp, mePtr->namePtr, NULL, valuePtr,
TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
result = TCL_ERROR;
}
+ Tcl_DecrRefCount(valuePtr);
}
- if ((result == TCL_OK) && (mePtr->command != NULL)) {
- result = TkCopyAndGlobalEval(interp, mePtr->command);
+ if ((result == TCL_OK) && (mePtr->commandPtr != NULL)) {
+ Tcl_Obj *commandPtr = mePtr->commandPtr;
+
+ Tcl_IncrRefCount(commandPtr);
+ result = Tcl_EvalObjEx(interp, commandPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(commandPtr);
}
Tcl_Release((ClientData) mePtr);
done:
return result;
}
-
-
/*
*----------------------------------------------------------------------
@@ -951,13 +1143,12 @@ static void
DestroyMenuInstance(menuPtr)
TkMenu *menuPtr; /* Info about menu widget. */
{
- int i, numEntries = menuPtr->numEntries;
+ int i;
TkMenu *menuInstancePtr;
TkMenuEntry *cascadePtr, *nextCascadePtr;
- char *newArgv[2];
+ Tcl_Obj *newObjv[2];
TkMenu *parentMasterMenuPtr;
TkMenuEntry *parentMasterEntryPtr;
- TkMenu *parentMenuPtr;
/*
* If the menu has any cascade menu entries pointing to it, the cascade
@@ -979,18 +1170,29 @@ DestroyMenuInstance(menuPtr)
TkFreeMenuReferences(menuPtr->menuRefPtr);
for (; cascadePtr != NULL; cascadePtr = nextCascadePtr) {
- parentMenuPtr = cascadePtr->menuPtr;
nextCascadePtr = cascadePtr->nextCascadePtr;
if (menuPtr->masterMenuPtr != menuPtr) {
+ Tcl_Obj *menuNamePtr = Tcl_NewStringObj("-menu", -1);
+
parentMasterMenuPtr = cascadePtr->menuPtr->masterMenuPtr;
parentMasterEntryPtr =
parentMasterMenuPtr->entries[cascadePtr->index];
- newArgv[0] = "-menu";
- newArgv[1] = parentMasterEntryPtr->name;
- ConfigureMenuEntry(cascadePtr, 2, newArgv, TK_CONFIG_ARGV_ONLY);
+ 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, (char **) NULL, 0);
+ ConfigureMenuEntry(cascadePtr, 0, (Tcl_Obj **) NULL);
}
}
@@ -1010,20 +1212,27 @@ DestroyMenuInstance(menuPtr)
/*
* Free up all the stuff that requires special handling, then
- * let Tk_FreeOptions handle all the standard option-related
+ * let Tk_FreeConfigOptions handle all the standard option-related
* stuff.
*/
- for (i = numEntries - 1; i >= 0; i--) {
+ 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_FreeOptions(tkMenuConfigSpecs, (char *) menuPtr, menuPtr->display, 0);
-
- Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
+ Tk_FreeConfigOptions((char *) menuPtr,
+ menuPtr->optionTablesPtr->menuOptionTable, menuPtr->tkwin);
}
/*
@@ -1202,7 +1411,7 @@ DestroyMenuEntry(memPtr)
/*
* Free up all the stuff that requires special handling, then
- * let Tk_FreeOptions handle all the standard option-related
+ * let Tk_FreeConfigOptions handle all the standard option-related
* stuff.
*/
@@ -1215,15 +1424,17 @@ DestroyMenuEntry(memPtr)
if (mePtr->selectImage != NULL) {
Tk_FreeImage(mePtr->selectImage);
}
- if (mePtr->name != NULL) {
- Tcl_UntraceVar(menuPtr->interp, mePtr->name,
+ 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_FreeOptions(tkMenuEntryConfigSpecs, (char *) mePtr, menuPtr->display,
- (COMMAND_MASK << mePtr->type));
+ Tk_FreeConfigOptions((char *) mePtr, mePtr->optionTable, menuPtr->tkwin);
ckfree((char *) mePtr);
}
@@ -1259,7 +1470,6 @@ MenuWorldChanged(instanceData)
TkpConfigureMenuEntry(menuPtr->entries[i]);
}
}
-
/*
*----------------------------------------------------------------------
@@ -1272,7 +1482,7 @@ MenuWorldChanged(instanceData)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, font, etc. get set
@@ -1282,23 +1492,32 @@ MenuWorldChanged(instanceData)
*/
static int
-ConfigureMenu(interp, menuPtr, argc, argv, flags)
+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 argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to Tk_ConfigureWidget. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
{
int i;
- TkMenu* menuListPtr;
+ TkMenu *menuListPtr, *cleanupPtr;
+ int result;
for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
menuListPtr = menuListPtr->nextInstancePtr) {
-
- if (Tk_ConfigureWidget(interp, menuListPtr->tkwin,
- tkMenuConfigSpecs, argc, argv, (char *) menuListPtr,
- flags) != TCL_OK) {
+ menuListPtr->errorStructPtr = (Tk_SavedOptions *)
+ ckalloc(sizeof(Tk_SavedOptions));
+ result = Tk_SetOptions(interp, (char *) menuListPtr,
+ menuListPtr->optionTablesPtr->menuOptionTable, objc, objv,
+ menuListPtr->tkwin, menuListPtr->errorStructPtr, (int *) NULL);
+ if (result != TCL_OK) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
return TCL_ERROR;
}
@@ -1310,33 +1529,57 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
*/
if (menuListPtr->menuType == UNKNOWN_TYPE) {
- if (strcmp(menuListPtr->menuTypeName, "menubar") == 0) {
- menuListPtr->menuType = MENUBAR;
- } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
- menuListPtr->menuType = TEAROFF_MENU;
- } else {
- menuListPtr->menuType = MASTER_MENU;
+ 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->tearoff) {
if ((menuListPtr->numEntries == 0)
|| (menuListPtr->entries[0]->type != TEAROFF_ENTRY)) {
if (MenuNewEntry(menuListPtr, 0, TEAROFF_ENTRY) == NULL) {
+ if (menuListPtr->errorStructPtr != NULL) {
+ for (cleanupPtr = menuPtr->masterMenuPtr;
+ cleanupPtr != menuListPtr;
+ cleanupPtr = cleanupPtr->nextInstancePtr) {
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
+ Tk_RestoreSavedOptions(cleanupPtr->errorStructPtr);
+ ckfree((char *) cleanupPtr->errorStructPtr);
+ cleanupPtr->errorStructPtr = NULL;
+ }
return TCL_ERROR;
}
}
} else if ((menuListPtr->numEntries > 0)
&& (menuListPtr->entries[0]->type == TEAROFF_ENTRY)) {
int i;
-
+
Tcl_EventuallyFree((ClientData) menuListPtr->entries[0],
DestroyMenuEntry);
+
for (i = 0; i < menuListPtr->numEntries - 1; i++) {
menuListPtr->entries[i] = menuListPtr->entries[i + 1];
menuListPtr->entries[i]->index = i;
@@ -1349,21 +1592,6 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
}
TkMenuConfigureDrawOptions(menuListPtr);
-
- /*
- * Configure the new window to be either a pop-up menu
- * or a tear-off menu.
- * We don't do this for menubars since they are not toplevel
- * windows. Also, since this gets called before CloneMenu has
- * a chance to set the menuType field, we have to look at the
- * menuTypeName field to tell that this is a menu bar.
- */
-
- if (strcmp(menuListPtr->menuTypeName, "normal") == 0) {
- TkpMakeMenuWindow(menuListPtr->tkwin, 1);
- } else if (strcmp(menuListPtr->menuTypeName, "tearoff") == 0) {
- TkpMakeMenuWindow(menuListPtr->tkwin, 0);
- }
/*
* After reconfiguring a menu, we need to reconfigure all of the
@@ -1376,28 +1604,35 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
TkMenuEntry *mePtr;
mePtr = menuListPtr->entries[i];
- ConfigureMenuEntry(mePtr, 0,
- (char **) NULL, TK_CONFIG_ARGV_ONLY
- | COMMAND_MASK << mePtr->type);
+ 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;
}
+
/*
*----------------------------------------------------------------------
*
- * ConfigureMenuEntry --
+ * PostProcessEntry --
*
- * This procedure is called to process an argv/argc list in order
- * to configure (or reconfigure) one entry in a menu.
+ * 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 interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information such as label and accelerator get
@@ -1407,55 +1642,29 @@ ConfigureMenu(interp, menuPtr, argc, argv, flags)
*/
static int
-ConfigureMenuEntry(mePtr, argc, argv, flags)
- register TkMenuEntry *mePtr; /* Information about menu entry; may
- * or may not already have values for
- * some fields. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Additional flags to pass to
- * Tk_ConfigureWidget. */
+PostProcessEntry(mePtr)
+ TkMenuEntry *mePtr; /* The entry we are configuring. */
{
TkMenu *menuPtr = mePtr->menuPtr;
int index = mePtr->index;
+ char *name;
Tk_Image image;
/*
- * If this entry is a check button or radio button, then remove
- * its old trace procedure.
- */
-
- if ((mePtr->name != NULL)
- && ((mePtr->type == CHECK_BUTTON_ENTRY)
- || (mePtr->type == RADIO_BUTTON_ENTRY))) {
- Tcl_UntraceVar(menuPtr->interp, mePtr->name,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MenuVarProc, (ClientData) mePtr);
- }
-
- if (menuPtr->tkwin != NULL) {
- if (Tk_ConfigureWidget(menuPtr->interp, menuPtr->tkwin,
- tkMenuEntryConfigSpecs, argc, argv, (char *) mePtr,
- flags | (COMMAND_MASK << mePtr->type)) != TCL_OK) {
- return TCL_ERROR;
- }
- }
-
- /*
* The code below handles special configuration stuff not taken
* care of by Tk_ConfigureWidget, such as special processing for
* defaults, sizing strings, graphics contexts, etc.
*/
- if (mePtr->label == NULL) {
+ if (mePtr->labelPtr == NULL) {
mePtr->labelLength = 0;
} else {
- mePtr->labelLength = strlen(mePtr->label);
+ Tcl_GetStringFromObj(mePtr->labelPtr, &mePtr->labelLength);
}
- if (mePtr->accel == NULL) {
+ if (mePtr->accelPtr == NULL) {
mePtr->accelLength = 0;
} else {
- mePtr->accelLength = strlen(mePtr->accel);
+ Tcl_GetStringFromObj(mePtr->accelPtr, &mePtr->accelLength);
}
/*
@@ -1464,9 +1673,8 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
* cascades have to be updated.
*/
- if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
TkMenuEntry *cascadeEntryPtr;
- TkMenu *cascadeMenuPtr;
int alreadyThere;
TkMenuReferences *menuRefPtr;
char *oldHashKey = NULL; /* Initialization only needed to
@@ -1482,19 +1690,18 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
* 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, mePtr->name) != 0) {
+ if (strcmp(oldHashKey, name) != 0) {
UnhookCascadeEntry(mePtr);
}
}
if ((mePtr->childMenuRefPtr == NULL)
- || (strcmp(oldHashKey, mePtr->name) != 0)) {
- menuRefPtr = TkCreateMenuReferences(menuPtr->interp,
- mePtr->name);
- cascadeMenuPtr = menuRefPtr->menuPtr;
+ || (strcmp(oldHashKey, name) != 0)) {
+ menuRefPtr = TkCreateMenuReferences(menuPtr->interp, name);
mePtr->childMenuRefPtr = menuRefPtr;
if (menuRefPtr->parentEntryPtr == NULL) {
@@ -1531,52 +1738,15 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
return TCL_ERROR;
}
- if ((mePtr->type == CHECK_BUTTON_ENTRY)
- || (mePtr->type == RADIO_BUTTON_ENTRY)) {
- char *value;
-
- if (mePtr->name == NULL) {
- mePtr->name =
- (char *) ckalloc((unsigned) (mePtr->labelLength + 1));
- strcpy(mePtr->name, (mePtr->label == NULL) ? "" : mePtr->label);
- }
- if (mePtr->onValue == NULL) {
- mePtr->onValue = (char *) ckalloc((unsigned)
- (mePtr->labelLength + 1));
- strcpy(mePtr->onValue, (mePtr->label == NULL) ? "" : mePtr->label);
- }
-
- /*
- * Select the entry if the associated variable has the
- * appropriate value, initialize the variable if it doesn't
- * exist, then set a trace on the variable to monitor future
- * changes to its value.
- */
-
- value = Tcl_GetVar(menuPtr->interp, mePtr->name, TCL_GLOBAL_ONLY);
- mePtr->entryFlags &= ~ENTRY_SELECTED;
- if (value != NULL) {
- if (strcmp(value, mePtr->onValue) == 0) {
- mePtr->entryFlags |= ENTRY_SELECTED;
- }
- } else {
- Tcl_SetVar(menuPtr->interp, mePtr->name,
- (mePtr->type == CHECK_BUTTON_ENTRY) ? mePtr->offValue : "",
- TCL_GLOBAL_ONLY);
- }
- Tcl_TraceVar(menuPtr->interp, mePtr->name,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- MenuVarProc, (ClientData) mePtr);
- }
-
/*
* Get the images for the entry, if there are any. Allocate the
* new images before freeing the old ones, so that the reference
* counts don't go to zero and cause image data to be discarded.
*/
- if (mePtr->imageString != NULL) {
- image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->imageString,
+ 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;
@@ -1588,8 +1758,10 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
Tk_FreeImage(mePtr->image);
}
mePtr->image = image;
- if (mePtr->selectImageString != NULL) {
- image = Tk_GetImage(menuPtr->interp, menuPtr->tkwin, mePtr->selectImageString,
+ 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;
@@ -1602,7 +1774,69 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
}
mePtr->selectImage = image;
- TkEventuallyRecomputeMenu(menuPtr);
+ 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;
}
@@ -1610,13 +1844,78 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
/*
*----------------------------------------------------------------------
*
+ * 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 interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information such as label and accelerator get
@@ -1626,22 +1925,21 @@ ConfigureMenuEntry(mePtr, argc, argv, flags)
*/
static int
-ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
+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 argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Additional flags to pass to
- * Tk_ConfigureWidget. */
+ int objc; /* Number of valid entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Arguments. */
{
TkMenuEntry *mePtr;
TkMenu *menuListPtr;
- char *oldCascadeName = NULL, *newMenuName = NULL;
- int cascadeEntryChanged;
+ 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
@@ -1653,21 +1951,47 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
mePtr = menuPtr->masterMenuPtr->entries[index];
if (mePtr->type == CASCADE_ENTRY) {
- oldCascadeName = mePtr->name;
+ oldCascadePtr = mePtr->namePtr;
+ if (oldCascadePtr != NULL) {
+ Tcl_IncrRefCount(oldCascadePtr);
+ }
}
- if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- cascadeEntryChanged = (mePtr->type == CASCADE_ENTRY)
- && (oldCascadeName != mePtr->name);
+ 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) {
- newMenuName = mePtr->name;
- if (newMenuName != NULL) {
+ if (mePtr->namePtr != NULL) {
+ newCascadeName = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
cascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
- mePtr->name);
+ newCascadeName);
}
}
@@ -1677,9 +2001,9 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
mePtr = menuListPtr->entries[index];
- if (cascadeEntryChanged && (mePtr->name != NULL)) {
- oldCascadeMenuRefPtr = TkFindMenuReferences(menuPtr->interp,
- mePtr->name);
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
+ oldCascadeMenuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ mePtr->namePtr);
if ((oldCascadeMenuRefPtr != NULL)
&& (oldCascadeMenuRefPtr->menuPtr != NULL)) {
@@ -1687,25 +2011,36 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
}
}
- if (ConfigureMenuEntry(mePtr, argc, argv, flags) != TCL_OK) {
+ if (ConfigureMenuEntry(mePtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
- if (cascadeEntryChanged && (newMenuName != NULL)) {
+ if (cascadeEntryChanged && (mePtr->namePtr != NULL)) {
if (cascadeMenuRefPtr->menuPtr != NULL) {
- char *newArgV[2];
- char *newCloneName;
-
- newCloneName = TkNewMenuName(menuPtr->interp,
- Tk_PathName(menuListPtr->tkwin),
+ 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);
- CloneMenu(cascadeMenuRefPtr->menuPtr, newCloneName,
- "normal");
-
- newArgV[0] = "-menu";
- newArgV[1] = newCloneName;
- ConfigureMenuEntry(mePtr, 2, newArgV, flags);
- ckfree(newCloneName);
+ 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);
}
}
}
@@ -1724,7 +2059,7 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
* A standard Tcl result. If all went well, then *indexPtr is
* filled in with the entry index corresponding to string
* (ranges from -1 to the number of entries in the menu minus
- * one). Otherwise an error message is left in interp->result.
+ * one). Otherwise an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -1733,38 +2068,39 @@ ConfigureMenuCloneEntries(interp, menuPtr, index, argc, argv, flags)
*/
int
-TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
+TkGetMenuIndex(interp, menuPtr, objPtr, lastOK, indexPtr)
Tcl_Interp *interp; /* For error messages. */
TkMenu *menuPtr; /* Menu for which the index is being
* specified. */
- char *string; /* Specification of an entry in menu. See
+ 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 relief. */
+ 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;
- return TCL_OK;
+ goto success;
}
if (((string[0] == 'l') && (strcmp(string, "last") == 0))
|| ((string[0] == 'e') && (strcmp(string, "end") == 0))) {
*indexPtr = menuPtr->numEntries - ((lastOK) ? 0 : 1);
- return TCL_OK;
+ goto success;
}
if ((string[0] == 'n') && (strcmp(string, "none") == 0)) {
*indexPtr = -1;
- return TCL_OK;
+ goto success;
}
if (string[0] == '@') {
if (GetIndexFromCoords(interp, menuPtr, string, indexPtr)
== TCL_OK) {
- return TCL_OK;
+ goto success;
}
}
@@ -1780,25 +2116,29 @@ TkGetMenuIndex(interp, menuPtr, string, lastOK, indexPtr)
i = -1;
}
*indexPtr = i;
- return TCL_OK;
+ goto success;
}
Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
}
for (i = 0; i < menuPtr->numEntries; i++) {
- char *label;
-
- label = menuPtr->entries[i]->label;
+ Tcl_Obj *labelPtr = menuPtr->entries[i]->labelPtr;
+ char *label = (labelPtr == NULL) ? NULL
+ : Tcl_GetStringFromObj(labelPtr, NULL);
+
if ((label != NULL)
- && (Tcl_StringMatch(menuPtr->entries[i]->label, string))) {
+ && (Tcl_StringMatch(label, string))) {
*indexPtr = i;
- return TCL_OK;
+ goto success;
}
}
Tcl_AppendResult(interp, "bad menu entry index \"",
string, "\"", (char *) NULL);
return TCL_ERROR;
+
+success:
+ return TCL_OK;
}
/*
@@ -1834,7 +2174,6 @@ MenuCmdDeletedProc(clientData)
*/
if (tkwin != NULL) {
- menuPtr->tkwin = NULL;
Tk_DestroyWindow(tkwin);
}
}
@@ -1890,41 +2229,49 @@ MenuNewEntry(menuPtr, index, type)
mePtr = (TkMenuEntry *) ckalloc(sizeof(TkMenuEntry));
menuPtr->entries[index] = mePtr;
mePtr->type = type;
+ mePtr->optionTable = menuPtr->optionTablesPtr->entryOptionTables[type];
mePtr->menuPtr = menuPtr;
- mePtr->label = NULL;
+ mePtr->labelPtr = NULL;
mePtr->labelLength = 0;
mePtr->underline = -1;
- mePtr->bitmap = None;
- mePtr->imageString = NULL;
+ mePtr->bitmapPtr = NULL;
+ mePtr->imagePtr = NULL;
mePtr->image = NULL;
- mePtr->selectImageString = NULL;
+ mePtr->selectImagePtr = NULL;
mePtr->selectImage = NULL;
- mePtr->accel = NULL;
+ mePtr->accelPtr = NULL;
mePtr->accelLength = 0;
- mePtr->state = tkNormalUid;
- mePtr->border = NULL;
- mePtr->fg = NULL;
- mePtr->activeBorder = NULL;
- mePtr->activeFg = NULL;
- mePtr->tkfont = NULL;
- mePtr->indicatorOn = 1;
- mePtr->indicatorFg = NULL;
+ mePtr->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->command = NULL;
- mePtr->name = NULL;
+ mePtr->commandPtr = NULL;
+ mePtr->namePtr = NULL;
mePtr->childMenuRefPtr = NULL;
- mePtr->onValue = NULL;
- mePtr->offValue = 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;
}
@@ -1946,25 +2293,24 @@ MenuNewEntry(menuPtr, index, type)
*/
static int
-MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
+MenuAddOrInsert(interp, menuPtr, indexPtr, objc, objv)
Tcl_Interp *interp; /* Used for error reporting. */
TkMenu *menuPtr; /* Widget in which to create new
* entry. */
- char *indexString; /* String describing index at which
+ Tcl_Obj *indexPtr; /* Object describing index at which
* to insert. NULL means insert at
* end. */
- int argc; /* Number of elements in argv. */
- char **argv; /* Arguments to command: first arg
+ 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 c, type, index;
- size_t length;
+ int type, index;
TkMenuEntry *mePtr;
TkMenu *menuListPtr;
- if (indexString != NULL) {
- if (TkGetMenuIndex(interp, menuPtr, indexString, 1, &index)
+ if (indexPtr != NULL) {
+ if (TkGetMenuIndex(interp, menuPtr, indexPtr, 1, &index)
!= TCL_OK) {
return TCL_ERROR;
}
@@ -1972,11 +2318,12 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
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)) {
+ if (menuPtr->tearoff && (index == 0)) {
index = 1;
}
@@ -1984,30 +2331,11 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
* Figure out the type of the new entry.
*/
- c = argv[0][0];
- length = strlen(argv[0]);
- if ((c == 'c') && (strncmp(argv[0], "cascade", length) == 0)
- && (length >= 2)) {
- type = CASCADE_ENTRY;
- } else if ((c == 'c') && (strncmp(argv[0], "checkbutton", length) == 0)
- && (length >= 2)) {
- type = CHECK_BUTTON_ENTRY;
- } else if ((c == 'c') && (strncmp(argv[0], "command", length) == 0)
- && (length >= 2)) {
- type = COMMAND_ENTRY;
- } else if ((c == 'r')
- && (strncmp(argv[0], "radiobutton", length) == 0)) {
- type = RADIO_BUTTON_ENTRY;
- } else if ((c == 's')
- && (strncmp(argv[0], "separator", length) == 0)) {
- type = SEPARATOR_ENTRY;
- } else {
- Tcl_AppendResult(interp, "bad menu entry type \"",
- argv[0], "\": must be cascade, checkbutton, ",
- "command, radiobutton, or separator", (char *) NULL);
+ 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.
*/
@@ -2019,9 +2347,9 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
if (mePtr == NULL) {
return TCL_ERROR;
}
- if (ConfigureMenuEntry(mePtr, argc-1, argv+1, 0) != TCL_OK) {
+ if (ConfigureMenuEntry(mePtr, objc - 1, objv + 1) != TCL_OK) {
TkMenu *errorMenuPtr;
- int i;
+ int i;
for (errorMenuPtr = menuPtr->masterMenuPtr;
errorMenuPtr != NULL;
@@ -2054,28 +2382,40 @@ MenuAddOrInsert(interp, menuPtr, indexString, argc, argv)
*/
if ((menuPtr != menuListPtr) && (type == CASCADE_ENTRY)) {
- if ((mePtr->name != NULL) && (mePtr->childMenuRefPtr != NULL)
+ if ((mePtr->namePtr != NULL)
+ && (mePtr->childMenuRefPtr != NULL)
&& (mePtr->childMenuRefPtr->menuPtr != NULL)) {
TkMenu *cascadeMenuPtr =
mePtr->childMenuRefPtr->menuPtr->masterMenuPtr;
- char *newCascadeName;
- char *newArgv[2];
+ 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;
-
- newCascadeName = TkNewMenuName(menuListPtr->interp,
- Tk_PathName(menuListPtr->tkwin),
- cascadeMenuPtr);
- CloneMenu(cascadeMenuPtr, newCascadeName, "normal");
+
+ Tcl_IncrRefCount(windowNamePtr);
+ newCascadePtr = TkNewMenuName(menuListPtr->interp,
+ windowNamePtr, cascadeMenuPtr);
+ Tcl_IncrRefCount(newCascadePtr);
+ Tcl_IncrRefCount(normalPtr);
+ CloneMenu(cascadeMenuPtr, newCascadePtr, normalPtr);
- menuRefPtr = TkFindMenuReferences(menuListPtr->interp,
- newCascadeName);
+ menuRefPtr = TkFindMenuReferencesObj(menuListPtr->interp,
+ newCascadePtr);
if (menuRefPtr == NULL) {
panic("CloneMenu failed inside of MenuAddOrInsert.");
}
- newArgv[0] = "-menu";
- newArgv[1] = newCascadeName;
- ConfigureMenuEntry(mePtr, 2, newArgv, 0);
- ckfree(newCascadeName);
+ 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);
}
}
}
@@ -2112,6 +2452,8 @@ MenuVarProc(clientData, interp, name1, name2, flags)
TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
TkMenu *menuPtr;
char *value;
+ char *name = Tcl_GetStringFromObj(mePtr->namePtr, NULL);
+ char *onValue;
menuPtr = mePtr->menuPtr;
@@ -2123,7 +2465,7 @@ MenuVarProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
mePtr->entryFlags &= ~ENTRY_SELECTED;
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
- Tcl_TraceVar(interp, mePtr->name,
+ Tcl_TraceVar(interp, name,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuVarProc, clientData);
}
@@ -2137,17 +2479,22 @@ MenuVarProc(clientData, interp, name1, name2, flags)
* the menu entry.
*/
- value = Tcl_GetVar(interp, mePtr->name, TCL_GLOBAL_ONLY);
+ value = Tcl_GetVar(interp, name, TCL_GLOBAL_ONLY);
if (value == NULL) {
value = "";
}
- if (strcmp(value, mePtr->onValue) == 0) {
- if (mePtr->entryFlags & ENTRY_SELECTED) {
+ 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;
}
- mePtr->entryFlags |= ENTRY_SELECTED;
- } else if (mePtr->entryFlags & ENTRY_SELECTED) {
- mePtr->entryFlags &= ~ENTRY_SELECTED;
} else {
return (char *) NULL;
}
@@ -2193,15 +2540,15 @@ TkActivateMenuEntry(menuPtr, index)
* might already have been changed to disabled).
*/
- if (mePtr->state == tkActiveUid) {
- mePtr->state = tkNormalUid;
+ 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 = tkActiveUid;
+ mePtr->state = ENTRY_ACTIVE;
TkEventuallyRedrawMenu(menuPtr, mePtr);
}
return result;
@@ -2237,9 +2584,13 @@ TkPostCommand(menuPtr)
* the menu's geometry if needed.
*/
- if (menuPtr->postCommand != NULL) {
- result = TkCopyAndGlobalEval(menuPtr->interp,
- menuPtr->postCommand);
+ 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;
}
@@ -2269,64 +2620,53 @@ TkPostCommand(menuPtr)
*/
static int
-CloneMenu(menuPtr, newMenuName, newMenuTypeString)
+CloneMenu(menuPtr, newMenuNamePtr, newMenuTypePtr)
TkMenu *menuPtr; /* The menu we are going to clone */
- char *newMenuName; /* The name to give the new menu */
- char *newMenuTypeString; /* What kind of menu is this, a normal menu
+ 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;
- size_t length;
+ int menuType, i;
TkMenuReferences *menuRefPtr;
- Tcl_Obj *commandObjPtr;
+ Tcl_Obj *menuDupCommandArray[4];
- if (newMenuTypeString == NULL) {
+ if (newMenuTypePtr == NULL) {
menuType = MASTER_MENU;
} else {
- length = strlen(newMenuTypeString);
- if (strncmp(newMenuTypeString, "normal", length) == 0) {
- menuType = MASTER_MENU;
- } else if (strncmp(newMenuTypeString, "tearoff", length) == 0) {
- menuType = TEAROFF_MENU;
- } else if (strncmp(newMenuTypeString, "menubar", length) == 0) {
- menuType = MENUBAR;
- } else {
- Tcl_AppendResult(menuPtr->interp,
- "bad menu type - must be normal, tearoff, or menubar",
- (char *) NULL);
- return TCL_ERROR;
- }
+ if (Tcl_GetIndexFromObj(menuPtr->interp, newMenuTypePtr,
+ menuTypeStrings, "menu type", 0, &menuType) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
- commandObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj("tkMenuDup", -1));
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1));
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj(newMenuName, -1));
- if ((newMenuTypeString == NULL) || (newMenuTypeString[0] == '\0')) {
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj("normal", -1));
+ menuDupCommandArray[0] = Tcl_NewStringObj("tkMenuDup", -1);
+ menuDupCommandArray[1] = Tcl_NewStringObj(Tk_PathName(menuPtr->tkwin), -1);
+ menuDupCommandArray[2] = newMenuNamePtr;
+ if (newMenuTypePtr == NULL) {
+ menuDupCommandArray[3] = Tcl_NewStringObj("normal", -1);
} else {
- Tcl_ListObjAppendElement(menuPtr->interp, commandObjPtr,
- Tcl_NewStringObj(newMenuTypeString, -1));
+ menuDupCommandArray[3] = newMenuTypePtr;
+ }
+ for (i = 0; i < 4; i++) {
+ Tcl_IncrRefCount(menuDupCommandArray[i]);
}
- Tcl_IncrRefCount(commandObjPtr);
Tcl_Preserve((ClientData) menuPtr);
- returnResult = Tcl_EvalObj(menuPtr->interp, commandObjPtr);
- Tcl_DecrRefCount(commandObjPtr);
+ 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 = TkFindMenuReferences(menuPtr->interp, newMenuName))
- != (TkMenuReferences *) NULL)
+ ((menuRefPtr = TkFindMenuReferencesObj(menuPtr->interp,
+ newMenuNamePtr)) != (TkMenuReferences *) NULL)
&& (menuPtr->numEntries == menuRefPtr->menuPtr->numEntries)) {
TkMenu *newMenuPtr = menuRefPtr->menuPtr;
+ Tcl_Obj *newObjv[3];
char *newArgv[3];
int i, numElements;
@@ -2359,8 +2699,8 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
if (Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
newMenuPtr->interp, 2, newArgv) == TCL_OK) {
char *windowName;
- Tcl_Obj *bindingsPtr =
- Tcl_NewStringObj(newMenuPtr->interp->result, -1);
+ Tcl_Obj *bindingsPtr =
+ Tcl_DuplicateObj(Tcl_GetObjResult(newMenuPtr->interp));
Tcl_Obj *elementPtr;
Tcl_ListObjLength(newMenuPtr->interp, bindingsPtr, &numElements);
@@ -2372,11 +2712,12 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
== 0) {
Tcl_Obj *newElementPtr = Tcl_NewStringObj(
Tk_PathName(newMenuPtr->masterMenuPtr->tkwin), -1);
+ Tcl_IncrRefCount(newElementPtr);
Tcl_ListObjReplace(menuPtr->interp, bindingsPtr,
i + 1, 0, 1, &newElementPtr);
newArgv[2] = Tcl_GetStringFromObj(bindingsPtr, NULL);
- Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
- menuPtr->interp, 3, newArgv);
+ Tk_BindtagsCmd((ClientData)newMenuPtr->tkwin,
+ menuPtr->interp, 3, newArgv);
break;
}
}
@@ -2389,30 +2730,35 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
*/
for (i = 0; i < menuPtr->numEntries; i++) {
- char *newCascadeName;
TkMenuReferences *cascadeRefPtr;
TkMenu *oldCascadePtr;
if ((menuPtr->entries[i]->type == CASCADE_ENTRY)
- && (menuPtr->entries[i]->name != NULL)) {
+ && (menuPtr->entries[i]->namePtr != NULL)) {
cascadeRefPtr =
- TkFindMenuReferences(menuPtr->interp,
- menuPtr->entries[i]->name);
+ TkFindMenuReferencesObj(menuPtr->interp,
+ menuPtr->entries[i]->namePtr);
if ((cascadeRefPtr != NULL) && (cascadeRefPtr->menuPtr)) {
- char *nameString;
+ Tcl_Obj *windowNamePtr =
+ Tcl_NewStringObj(Tk_PathName(newMenuPtr->tkwin),
+ -1);
+ Tcl_Obj *newCascadePtr;
oldCascadePtr = cascadeRefPtr->menuPtr;
- nameString = Tk_PathName(newMenuPtr->tkwin);
- newCascadeName = TkNewMenuName(menuPtr->interp,
- nameString, oldCascadePtr);
- CloneMenu(oldCascadePtr, newCascadeName, NULL);
-
- newArgv[0] = "-menu";
- newArgv[1] = newCascadeName;
- ConfigureMenuEntry(newMenuPtr->entries[i], 2, newArgv,
- TK_CONFIG_ARGV_ONLY);
- ckfree(newCascadeName);
+ 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);
}
}
}
@@ -2442,22 +2788,24 @@ CloneMenu(menuPtr, newMenuName, newMenuTypeString)
*/
static int
-MenuDoYPosition(interp, menuPtr, arg)
+MenuDoYPosition(interp, menuPtr, objPtr)
Tcl_Interp *interp;
TkMenu *menuPtr;
- char *arg;
+ Tcl_Obj *objPtr;
{
int index;
TkRecomputeMenu(menuPtr);
- if (TkGetMenuIndex(interp, menuPtr, arg, 0, &index) != TCL_OK) {
+ if (TkGetMenuIndex(interp, menuPtr, objPtr, 0, &index) != TCL_OK) {
goto error;
}
+ Tcl_ResetResult(interp);
if (index < 0) {
- interp->result = "0";
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
} else {
- sprintf(interp->result, "%d", menuPtr->entries[index]->y);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(menuPtr->entries[index]->y));
}
+
return TCL_OK;
error:
@@ -2507,7 +2855,8 @@ GetIndexFromCoords(interp, menuPtr, string, indexPtr)
goto error;
}
} else {
- x = menuPtr->borderWidth;
+ Tk_GetPixelsFromObj(interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &x);
}
for (i = 0; i < menuPtr->numEntries; i++) {
@@ -2583,65 +2932,66 @@ RecursivelyDeleteMenu(menuPtr)
*----------------------------------------------------------------------
*/
-char *
-TkNewMenuName(interp, parentName, menuPtr)
+Tcl_Obj *
+TkNewMenuName(interp, parentPtr, menuPtr)
Tcl_Interp *interp; /* The interp the new name has to live in.*/
- char *parentName; /* The prefix path of the new name. */
+ Tcl_Obj *parentPtr; /* The prefix path of the new name. */
TkMenu *menuPtr; /* The menu we are cloning. */
{
- Tcl_DString resultDString;
- Tcl_DString childDString;
+ Tcl_Obj *resultPtr = NULL; /* Initialization needed only to prevent
+ * compiler warning. */
+ Tcl_Obj *childPtr;
char *destString;
- int offset, i;
- int doDot = parentName[strlen(parentName) - 1] != '.';
+ int i;
+ int doDot;
Tcl_CmdInfo cmdInfo;
- char *returnString;
Tcl_HashTable *nameTablePtr = NULL;
TkWindow *winPtr = (TkWindow *) menuPtr->tkwin;
+ char *parentName = Tcl_GetStringFromObj(parentPtr, NULL);
+
if (winPtr->mainPtr != NULL) {
nameTablePtr = &(winPtr->mainPtr->nameTable);
}
-
- Tcl_DStringInit(&childDString);
- Tcl_DStringAppend(&childDString, Tk_PathName(menuPtr->tkwin), -1);
- for (destString = Tcl_DStringValue(&childDString);
+
+ 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 = '#';
}
}
- offset = 0;
-
for (i = 0; ; i++) {
if (i == 0) {
- Tcl_DStringInit(&resultDString);
- Tcl_DStringAppend(&resultDString, parentName, -1);
+ resultPtr = Tcl_DuplicateObj(parentPtr);
if (doDot) {
- Tcl_DStringAppend(&resultDString, ".", -1);
+ Tcl_AppendToObj(resultPtr, ".", -1);
}
- Tcl_DStringAppend(&resultDString,
- Tcl_DStringValue(&childDString), -1);
- destString = Tcl_DStringValue(&resultDString);
+ Tcl_AppendObjToObj(resultPtr, childPtr);
} else {
- if (i == 1) {
- offset = Tcl_DStringLength(&resultDString);
- Tcl_DStringSetLength(&resultDString, offset + 10);
- destString = Tcl_DStringValue(&resultDString);
- }
- sprintf(destString + offset, "%d", i);
+ 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;
}
}
- returnString = ckalloc(strlen(destString) + 1);
- strcpy(returnString, destString);
- Tcl_DStringFree(&resultDString);
- Tcl_DStringFree(&childDString);
- return returnString;
+ Tcl_DecrRefCount(childPtr);
+ return resultPtr;
}
/*
@@ -2756,32 +3106,45 @@ TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName)
menuPtr = menuRefPtr->menuPtr;
if (menuPtr != NULL) {
- char *cloneMenuName;
+ Tcl_Obj *cloneMenuPtr;
TkMenuReferences *cloneMenuRefPtr;
- char *newArgv[4];
+ 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.
*/
- cloneMenuName = TkNewMenuName(interp, Tk_PathName(tkwin),
+ Tcl_IncrRefCount(windowNamePtr);
+ cloneMenuPtr = TkNewMenuName(interp, windowNamePtr,
menuPtr);
- CloneMenu(menuPtr, cloneMenuName, "menubar");
+ Tcl_IncrRefCount(cloneMenuPtr);
+ Tcl_IncrRefCount(menubarPtr);
+ CloneMenu(menuPtr, cloneMenuPtr, menubarPtr);
- cloneMenuRefPtr = TkFindMenuReferences(interp, cloneMenuName);
+ 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;
- newArgv[0] = "-cursor";
- newArgv[1] = "";
+ newObjv[0] = cursorPtr;
+ newObjv[1] = nullPtr;
+ Tcl_IncrRefCount(cursorPtr);
+ Tcl_IncrRefCount(nullPtr);
ConfigureMenu(menuPtr->interp, cloneMenuRefPtr->menuPtr,
- 2, newArgv, TK_CONFIG_ARGV_ONLY);
+ 2, newObjv);
+ Tcl_DecrRefCount(cursorPtr);
+ Tcl_DecrRefCount(nullPtr);
}
TkpSetWindowMenuBar(tkwin, menuBarPtr);
-
- ckfree(cloneMenuName);
+ Tcl_DecrRefCount(cloneMenuPtr);
+ Tcl_DecrRefCount(menubarPtr);
+ Tcl_DecrRefCount(windowNamePtr);
} else {
TkpSetWindowMenuBar(tkwin, NULL);
}
@@ -2948,6 +3311,35 @@ TkFindMenuReferences(interp, pathName)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -3013,7 +3405,7 @@ DeleteMenuCloneEntries(menuPtr, first, last)
}
for (i = last + 1; i < menuListPtr->numEntries; i++) {
menuListPtr->entries[i - numDeleted] = menuListPtr->entries[i];
- menuListPtr->entries[i - numDeleted]->index = i;
+ menuListPtr->entries[i - numDeleted]->index = i - numDeleted;
}
menuListPtr->numEntries -= numDeleted;
if (menuListPtr->numEntries == 0) {
@@ -3050,8 +3442,21 @@ DeleteMenuCloneEntries(menuPtr, first, last)
void
TkMenuInit()
{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
if (!menusInitialized) {
- TkpMenuInit();
- menusInitialized = 1;
+ Tcl_MutexLock(&menuMutex);
+ if (!menusInitialized) {
+ TkpMenuInit();
+ menusInitialized = 1;
+ }
+ Tcl_MutexUnlock(&menuMutex);
+ }
+ if (!tsdPtr->menusInitialized) {
+ TkpMenuThreadInit();
+ tsdPtr->menusInitialized = 1;
}
}
+
+
diff --git a/tk/generic/tkMenu.h b/tk/generic/tkMenu.h
index 27b9dfa61b3..d1b8e39dd3a 100644
--- a/tk/generic/tkMenu.h
+++ b/tk/generic/tkMenu.h
@@ -3,7 +3,7 @@
*
* Declarations shared among all of the files that implement menu widgets.
*
- * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * 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.
@@ -47,66 +47,72 @@ typedef struct TkMenuEntry {
int type; /* Type of menu entry; see below for
* valid types. */
struct TkMenu *menuPtr; /* Menu with which this entry is associated. */
- char *label; /* Main text label displayed in entry (NULL
- * if no label). Malloc'ed. */
+ 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. */
- Tk_Uid state; /* State of button for display purposes:
+ int state; /* State of button for display purposes:
* normal, active, or disabled. */
- int underline; /* Index of character to underline. */
- Pixmap bitmap; /* Bitmap to display in menu entry, or None.
+ 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. */
- char *imageString; /* Name of image to display (malloc'ed), or
+ 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. */
- char *selectImageString; /* Name of image to display when selected
- * (malloc'ed), or NULL. */
+ 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. */
- char *accel; /* Accelerator string displayed at right
+ 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. */
+ * don't draw it. This field is ignored unless
+ * the entry is a radio or check button. */
/*
* Display attributes
*/
- Tk_3DBorder border; /* Structure used to draw background for
+ Tcl_Obj *borderPtr; /* Structure used to draw background for
* entry. NULL means use overall border
* for menu. */
- XColor *fg; /* Foreground color to use for entry. NULL
+ Tcl_Obj *fgPtr; /* Foreground color to use for entry. NULL
* means use foreground color from menu. */
- Tk_3DBorder activeBorder; /* Used to draw background and border when
+ Tcl_Obj *activeBorderPtr; /* Used to draw background and border when
* element is active. NULL means use
* activeBorder from menu. */
- XColor *activeFg; /* Foreground color to use when entry is
+ Tcl_Obj *activeFgPtr; /* Foreground color to use when entry is
* active. NULL means use active foreground
* from menu. */
- XColor *indicatorFg; /* Color for indicators in radio and check
+ Tcl_Obj *indicatorFgPtr; /* Color for indicators in radio and check
* button entries. NULL means use indicatorFg
* GC from menu. */
- Tk_Font tkfont; /* Text font for menu entries. NULL means
+ 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. */
+ * 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 palette menus.*/
+ * 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.
- */
+ * entry. */
int labelWidth; /* Number of pixels to allow for displaying
* labels in menu entries. */
@@ -114,15 +120,15 @@ typedef struct TkMenuEntry {
* Information used to implement this entry's action:
*/
- char *command; /* Command to invoke when entry is invoked.
+ Tcl_Obj *commandPtr; /* Command to invoke when entry is invoked.
* Malloc'ed. */
- char *name; /* Name of variable (for check buttons and
+ Tcl_Obj *namePtr; /* Name of variable (for check buttons and
* radio buttons) or menu (for cascade
* entries). Malloc'ed.*/
- char *onValue; /* Value to store in variable when selected
+ Tcl_Obj *onValuePtr; /* Value to store in variable when selected
* (only for radio and check buttons).
* Malloc'ed. */
- char *offValue; /* Value to store in variable when not
+ Tcl_Obj *offValuePtr; /* Value to store in variable when not
* selected (only for check buttons).
* Malloc'ed. */
@@ -179,7 +185,7 @@ typedef struct TkMenuEntry {
* does not yet exist. */
TkMenuPlatformEntryData platformEntryData;
/* The data for the specific type of menu.
- * Depends on platform and menu type what
+ * Depends on platform and menu type what
* kind of options are in this structure.
*/
} TkMenuEntry;
@@ -191,9 +197,9 @@ typedef struct TkMenuEntry {
* 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_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.
@@ -211,25 +217,22 @@ typedef struct TkMenuEntry {
* Types defined for MenuEntries:
*/
-#define COMMAND_ENTRY 0
-#define SEPARATOR_ENTRY 1
-#define CHECK_BUTTON_ENTRY 2
-#define RADIO_BUTTON_ENTRY 3
-#define CASCADE_ENTRY 4
-#define TEAROFF_ENTRY 5
+#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
/*
- * Mask bits for above types:
+ * Menu states
*/
-#define COMMAND_MASK TK_CONFIG_USER_BIT
-#define SEPARATOR_MASK (TK_CONFIG_USER_BIT << 1)
-#define CHECK_BUTTON_MASK (TK_CONFIG_USER_BIT << 2)
-#define RADIO_BUTTON_MASK (TK_CONFIG_USER_BIT << 3)
-#define CASCADE_MASK (TK_CONFIG_USER_BIT << 4)
-#define TEAROFF_MASK (TK_CONFIG_USER_BIT << 5)
-#define ALL_MASK (COMMAND_MASK | SEPARATOR_MASK \
- | CHECK_BUTTON_MASK | RADIO_BUTTON_MASK | CASCADE_MASK | TEAROFF_MASK)
+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
@@ -253,7 +256,7 @@ typedef struct TkMenu {
* nothing active. */
int menuType; /* MASTER_MENU, TEAROFF_MENU, or MENUBAR.
* See below for definitions. */
- char *menuTypeName; /* Used to control whether created tkwin
+ Tcl_Obj *menuTypePtr; /* Used to control whether created tkwin
* is a toplevel or not. "normal", "menubar",
* or "toplevel" */
@@ -261,20 +264,21 @@ typedef struct TkMenu {
* Information used when displaying widget:
*/
- Tk_3DBorder border; /* Structure used to draw 3-D
+ Tcl_Obj *borderPtr; /* Structure used to draw 3-D
* border and background for menu. */
- int borderWidth; /* Width of border around whole menu. */
- Tk_3DBorder activeBorder; /* Used to draw background and border for
+ Tcl_Obj *borderWidthPtr; /* Width of border around whole menu. */
+ Tcl_Obj *activeBorderPtr; /* Used to draw background and border for
* active element (if any). */
- int activeBorderWidth; /* Width of border around active element. */
- int relief; /* 3-d effect: TK_RELIEF_RAISED, etc. */
- Tk_Font tkfont; /* Text font for menu entries. */
- XColor *fg; /* Foreground color for entries. */
- XColor *disabledFg; /* Foreground color when disabled. NULL
+ 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. */
- XColor *activeFg; /* Foreground color for active entry. */
- XColor *indicatorFg; /* Color for indicators in radio and check
+ 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
@@ -305,7 +309,7 @@ typedef struct TkMenu {
* Miscellaneous information:
*/
- int tearOff; /* 1 means this menu can be torn off. On some
+ 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
@@ -313,17 +317,17 @@ typedef struct TkMenu {
* indicator (such as a dashed stripe) is
* drawn, and when the menu is selected, the
* tearoff is created. */
- char *title; /* The title to use when this menu is torn
+ 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. */
- char *tearOffCommand; /* If non-NULL, points to a command to
+ Tcl_Obj *tearoffCommandPtr; /* If non-NULL, points to a command to
* run whenever the menu is torn-off. */
- char *takeFocus; /* Value of -takefocus option; not used in
+ 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. */
- Tk_Cursor cursor; /* Current cursor for window, or None. */
- char *postCommand; /* Used to detect cycles in cascade hierarchy
+ 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. */
@@ -341,6 +345,9 @@ typedef struct TkMenu {
/* 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.
@@ -360,6 +367,13 @@ typedef struct TkMenu {
* 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;
/*
@@ -407,6 +421,16 @@ typedef struct TkMenuReferences {
} 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
@@ -453,13 +477,6 @@ typedef struct TkMenuReferences {
#define DECORATION_BORDER_WIDTH 2
/*
- * Configuration specs. Needed for platform-specific default initializations.
- */
-
-EXTERN Tk_ConfigSpec tkMenuEntryConfigSpecs[];
-EXTERN Tk_ConfigSpec tkMenuConfigSpecs[];
-
-/*
* Menu-related procedures that are shared among Tk modules but not exported
* to the outside world:
*/
@@ -470,21 +487,26 @@ EXTERN void TkBindMenu _ANSI_ARGS_((
Tk_Window tkwin, TkMenu *menuPtr));
EXTERN TkMenuReferences *
TkCreateMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
- char *pathName));
+ char *name));
EXTERN void TkDestroyMenu _ANSI_ARGS_((TkMenu *menuPtr));
-EXTERN void TkEventuallyRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkEventuallyRecomputeMenu _ANSI_ARGS_((
+ TkMenu *menuPtr));
EXTERN void TkEventuallyRedrawMenu _ANSI_ARGS_((
TkMenu *menuPtr, TkMenuEntry *mePtr));
EXTERN TkMenuReferences *
TkFindMenuReferences _ANSI_ARGS_((Tcl_Interp *interp,
- char *pathName));
+ 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, char *string, int lastOK,
+ TkMenu *menuPtr, Tcl_Obj *objPtr, int lastOK,
int *indexPtr));
-EXTERN void TkMenuInitializeDrawingFields _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkMenuInitializeDrawingFields _ANSI_ARGS_((
+ TkMenu *menuPtr));
EXTERN void TkMenuInitializeEntryDrawingFields _ANSI_ARGS_((
TkMenuEntry *mePtr));
EXTERN int TkInvokeMenu _ANSI_ARGS_((Tcl_Interp *interp,
@@ -506,8 +528,8 @@ EXTERN void TkMenuSelectImageProc _ANSI_ARGS_
((ClientData clientData, int x, int y,
int width, int height, int imgWidth,
int imgHeight));
-EXTERN char * TkNewMenuName _ANSI_ARGS_((Tcl_Interp *interp,
- char *parentName, TkMenu *menuPtr));
+EXTERN 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));
@@ -521,7 +543,8 @@ EXTERN void TkRecomputeMenu _ANSI_ARGS_((TkMenu *menuPtr));
* common code.
*/
-EXTERN void TkpComputeMenubarGeometry _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkpComputeMenubarGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr));
EXTERN void TkpComputeStandardMenuGeometry _ANSI_ARGS_
((TkMenu *menuPtr));
EXTERN int TkpConfigureMenuEntry
@@ -547,3 +570,4 @@ EXTERN void TkpSetWindowMenuBar _ANSI_ARGS_((Tk_Window tkwin,
#endif /* _TKMENU */
+
diff --git a/tk/generic/tkMenuDraw.c b/tk/generic/tkMenuDraw.c
index 6109310bb7a..123795c4801 100644
--- a/tk/generic/tkMenuDraw.c
+++ b/tk/generic/tkMenuDraw.c
@@ -31,7 +31,7 @@ static void DisplayMenu _ANSI_ARGS_((ClientData clientData));
* TkMenuInitializeDrawingFields --
*
* Fills in drawing fields of a new menu. Called when new menu is
- * created by Tk_MenuCmd.
+ * created by MenuCmd.
*
* Results:
* None.
@@ -188,6 +188,9 @@ TkMenuConfigureDrawOptions(menuPtr)
XGCValues gcValues;
GC newGC;
unsigned long mask;
+ Tk_3DBorder border, activeBorder;
+ Tk_Font tkfont;
+ XColor *fg, *activeFg, *indicatorFg;
XColor *foreground, *background;
/*
@@ -196,33 +199,40 @@ TkMenuConfigureDrawOptions(menuPtr)
* defaults that couldn't be specified to Tk_ConfigureWidget.
*/
- Tk_SetBackgroundFromBorder(menuPtr->tkwin, menuPtr->border);
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_SetBackgroundFromBorder(menuPtr->tkwin, border);
- gcValues.font = Tk_FontId(menuPtr->tkfont);
- gcValues.foreground = menuPtr->fg->pixel;
- gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
- newGC = Tk_GetGCColor(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
- &gcValues, menuPtr->fg, Tk_3DBorderColor(menuPtr->border));
+ 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(menuPtr->tkfont);
- background = Tk_3DBorderColor(menuPtr->border);
+ gcValues.font = Tk_FontId(tkfont);
+ background = Tk_3DBorderColor(border);
gcValues.background = background->pixel;
- if (menuPtr->disabledFg != NULL) {
- foreground = menuPtr->disabledFg;
+ if (menuPtr->disabledFgPtr != NULL) {
+ XColor *disabledFg;
+
+ disabledFg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->disabledFgPtr);
+ foreground = disabledFg;
gcValues.foreground = foreground->pixel;
mask = GCForeground|GCBackground|GCFont;
} else {
- foreground = background;
+ foreground = background;
background = NULL;
gcValues.foreground = gcValues.background;
mask = GCForeground;
if (menuPtr->gray == None) {
menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
- Tk_GetUid("gray50"));
+ "gray50");
}
if (menuPtr->gray != None) {
gcValues.fill_style = FillStippled;
@@ -230,47 +240,47 @@ TkMenuConfigureDrawOptions(menuPtr)
mask = GCForeground|GCFillStyle|GCStipple;
}
}
- newGC = Tk_GetGCColor(menuPtr->tkwin, mask, &gcValues, foreground,
- background);
+ newGC = Tk_GetGC(menuPtr->tkwin, mask, &gcValues);
if (menuPtr->disabledGC != None) {
Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
}
menuPtr->disabledGC = newGC;
- gcValues.foreground = Tk_3DBorderColor(menuPtr->border)->pixel;
+ gcValues.foreground = Tk_3DBorderColor(border)->pixel;
if (menuPtr->gray == None) {
menuPtr->gray = Tk_GetBitmap(menuPtr->interp, menuPtr->tkwin,
- Tk_GetUid("gray50"));
+ "gray50");
}
if (menuPtr->gray != None) {
gcValues.fill_style = FillStippled;
gcValues.stipple = menuPtr->gray;
- newGC = Tk_GetGCColor(menuPtr->tkwin,
- GCForeground|GCFillStyle|GCStipple, &gcValues,
- Tk_3DBorderColor(menuPtr->border), NULL);
+ newGC = Tk_GetGC(menuPtr->tkwin,
+ GCForeground|GCFillStyle|GCStipple, &gcValues);
}
if (menuPtr->disabledImageGC != None) {
Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
}
menuPtr->disabledImageGC = newGC;
- gcValues.font = Tk_FontId(menuPtr->tkfont);
- gcValues.foreground = menuPtr->activeFg->pixel;
- gcValues.background =
- Tk_3DBorderColor(menuPtr->activeBorder)->pixel;
- newGC = Tk_GetGCColor(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
- &gcValues, menuPtr->activeFg,
- Tk_3DBorderColor(menuPtr->activeBorder));
+ 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;
- gcValues.foreground = menuPtr->indicatorFg->pixel;
- gcValues.background = Tk_3DBorderColor(menuPtr->border)->pixel;
- newGC = Tk_GetGCColor(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
- &gcValues, menuPtr->indicatorFg,
- Tk_3DBorderColor(menuPtr->border));
+ 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);
}
@@ -306,9 +316,10 @@ TkMenuConfigureEntryDrawOptions(mePtr, index)
Tk_Font tkfont;
TkMenu *menuPtr = mePtr->menuPtr;
- tkfont = (mePtr->tkfont == NULL) ? menuPtr->tkfont : mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ (mePtr->fontPtr != NULL) ? mePtr->fontPtr : menuPtr->fontPtr);
- if (mePtr->state == tkActiveUid) {
+ if (mePtr->state == ENTRY_ACTIVE) {
if (index != menuPtr->active) {
TkActivateMenuEntry(menuPtr, index);
}
@@ -316,34 +327,26 @@ TkMenuConfigureEntryDrawOptions(mePtr, index)
if (index == menuPtr->active) {
TkActivateMenuEntry(menuPtr, -1);
}
- if ((mePtr->state != tkNormalUid)
- && (mePtr->state != tkDisabledUid)) {
- Tcl_AppendResult(menuPtr->interp, "bad state value \"",
- mePtr->state,
- "\": must be normal, active, or disabled", (char *) NULL);
- mePtr->state = tkNormalUid;
- return TCL_ERROR;
- }
}
- if ((mePtr->tkfont != NULL)
- || (mePtr->border != NULL)
- || (mePtr->fg != NULL)
- || (mePtr->activeBorder != NULL)
- || (mePtr->activeFg != NULL)
- || (mePtr->indicatorFg != NULL)) {
- XColor *foreground, *background;
-
- background = Tk_3DBorderColor(
- (mePtr->border != NULL)
- ? mePtr->border
- : menuPtr->border);
- foreground = (mePtr->fg != NULL)
- ? mePtr->fg
- : menuPtr->fg;
+ if ((mePtr->fontPtr != NULL)
+ || (mePtr->borderPtr != NULL)
+ || (mePtr->fgPtr != NULL)
+ || (mePtr->activeBorderPtr != NULL)
+ || (mePtr->activeFgPtr != NULL)
+ || (mePtr->indicatorFgPtr != NULL)) {
+ XColor *fg, *bg, *indicatorFg, *activeFg;
+ Tk_3DBorder border, activeBorder;
+
+ fg = Tk_GetColorFromObj(menuPtr->tkwin, (mePtr->fgPtr != NULL)
+ ? mePtr->fgPtr : menuPtr->fgPtr);
- gcValues.foreground = foreground->pixel;
- gcValues.background = background->pixel;
+ gcValues.foreground = fg->pixel;
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr != NULL) ? mePtr->borderPtr
+ : menuPtr->borderPtr);
+ bg = Tk_3DBorderColor(border);
+ gcValues.background = bg->pixel;
gcValues.font = Tk_FontId(tkfont);
@@ -354,48 +357,43 @@ TkMenuConfigureEntryDrawOptions(mePtr, index)
*/
gcValues.graphics_exposures = False;
- newGC = Tk_GetGCColor(menuPtr->tkwin,
+ newGC = Tk_GetGC(menuPtr->tkwin,
GCForeground|GCBackground|GCFont|GCGraphicsExposures,
- &gcValues, foreground, background);
-
- if (mePtr->indicatorFg != NULL) {
- foreground = mePtr->indicatorFg;
- gcValues.foreground = foreground->pixel;
- } else if (menuPtr->indicatorFg != NULL) {
- foreground = menuPtr->indicatorFg;
- gcValues.foreground = foreground->pixel;
- }
- newIndicatorGC = Tk_GetGCColor(menuPtr->tkwin,
+ &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, foreground, background);
-
- if ((menuPtr->disabledFg != NULL) || (mePtr->image != NULL)) {
- foreground = menuPtr->disabledFg;
- gcValues.foreground = foreground->pixel;
+ &gcValues);
+ if ((menuPtr->disabledFgPtr != NULL) || (mePtr->image != NULL)) {
+ fg = Tk_GetColorFromObj(menuPtr->tkwin,
+ menuPtr->disabledFgPtr);
+ gcValues.foreground = fg->pixel;
mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
} else {
- foreground = background;
- background = NULL;
+ fg = bg;
gcValues.foreground = gcValues.background;
gcValues.fill_style = FillStippled;
gcValues.stipple = menuPtr->gray;
mask = GCForeground|GCFillStyle|GCStipple;
}
- newDisabledGC = Tk_GetGCColor(menuPtr->tkwin, mask, &gcValues,
- foreground, background);
-
- foreground = (mePtr->activeFg != NULL)
- ? mePtr->activeFg
- : menuPtr->activeFg;
- gcValues.foreground = foreground->pixel;
- background = Tk_3DBorderColor(
- (mePtr->activeBorder != NULL)
- ? mePtr->activeBorder
- : menuPtr->activeBorder);
- gcValues.background = background->pixel;
- newActiveGC = Tk_GetGCColor(menuPtr->tkwin,
+ 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;
+ bg = Tk_3DBorderColor(activeBorder);
+ gcValues.background = bg->pixel;
+ newActiveGC = Tk_GetGC(menuPtr->tkwin,
GCForeground|GCBackground|GCFont|GCGraphicsExposures,
- &gcValues, foreground, background);
+ &gcValues);
} else {
newGC = None;
newActiveGC = None;
@@ -496,7 +494,7 @@ TkRecomputeMenu(menuPtr)
void
TkEventuallyRedrawMenu(menuPtr, mePtr)
register TkMenu *menuPtr; /* Information about menu to redraw. */
- register TkMenuEntry *mePtr; /* Entry to redraw. NULL means redraw
+ register TkMenuEntry *mePtr;/* Entry to redraw. NULL means redraw
* all the entries in the menu. */
{
int i;
@@ -637,21 +635,30 @@ DisplayMenu(clientData)
register TkMenuEntry *mePtr;
register Tk_Window tkwin = menuPtr->tkwin;
int index, strictMotif;
- Tk_Font tkfont = menuPtr->tkfont;
+ 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), menuPtr->border,
- menuPtr->borderWidth, menuPtr->borderWidth,
- Tk_Width(tkwin) - 2 * menuPtr->borderWidth,
- Tk_Height(tkwin) - 2 * menuPtr->borderWidth, 0,
- TK_RELIEF_FLAT);
+ 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);
@@ -661,7 +668,8 @@ DisplayMenu(clientData)
* all of the time.
*/
- Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(tkfont, &menuMetrics);
/*
* Loop through all of the entries, drawing them one at a time.
@@ -681,22 +689,22 @@ DisplayMenu(clientData)
} else {
if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
width = Tk_Width(menuPtr->tkwin) - mePtr->x
- - menuPtr->activeBorderWidth;
+ - activeBorderWidth;
} else {
- width = mePtr->width + menuPtr->borderWidth;
+ 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)
+ if ((index > 0) && (menuPtr->menuType != MENUBAR)
&& mePtr->columnBreak) {
mePtr = menuPtr->entries[index - 1];
- Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border,
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border,
mePtr->x, mePtr->y + mePtr->height,
mePtr->width,
- Tk_Height(tkwin) - mePtr->y - mePtr->height
- - menuPtr->activeBorderWidth, 0,
+ Tk_Height(tkwin) - mePtr->y - mePtr->height -
+ activeBorderWidth, 0,
TK_RELIEF_FLAT);
}
}
@@ -705,28 +713,29 @@ DisplayMenu(clientData)
int x, y, height;
if (menuPtr->numEntries == 0) {
- x = y = menuPtr->borderWidth;
- width = Tk_Width(tkwin) - 2 * menuPtr->activeBorderWidth;
- height = Tk_Height(tkwin) - 2 * menuPtr->activeBorderWidth;
+ 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),
- menuPtr->border, mePtr->x, mePtr->y + mePtr->height,
- mePtr->width, Tk_Height(tkwin) - mePtr->y - mePtr->height
- - menuPtr->activeBorderWidth, 0,
+ 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 - menuPtr->activeBorderWidth;
- height = Tk_Height(tkwin) - y - menuPtr->activeBorderWidth;
+ width = Tk_Width(tkwin) - x - activeBorderWidth;
+ height = Tk_Height(tkwin) - y - activeBorderWidth;
}
- Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), menuPtr->border, x, y,
+ 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),
- menuPtr->border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
- menuPtr->borderWidth, menuPtr->relief);
+ border, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), borderWidth,
+ relief);
}
/*
@@ -760,11 +769,12 @@ TkMenuEventProc(clientData, eventPtr)
TkEventuallyRecomputeMenu(menuPtr);
TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
} else if (eventPtr->type == ActivateNotify) {
- if (menuPtr->menuType == TEAROFF_MENU) {
- TkpSetMainMenubar(menuPtr->interp, menuPtr->tkwin, NULL);
- }
+ 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);
}
@@ -774,7 +784,7 @@ TkMenuEventProc(clientData, eventPtr)
if (menuPtr->menuFlags & RESIZE_PENDING) {
Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
}
- TkDestroyMenu(menuPtr);
+ Tcl_EventuallyFree((ClientData) menuPtr, TCL_DYNAMIC);
}
}
@@ -942,7 +952,6 @@ TkPostSubmenu(interp, menuPtr, mePtr)
* posted. NULL means make sure that
* no submenu is posted. */
{
- char string[30];
int result, x, y;
if (mePtr == menuPtr->postedCascade) {
@@ -950,6 +959,8 @@ TkPostSubmenu(interp, menuPtr, mePtr)
}
if (menuPtr->postedCascade != NULL) {
+ char *name = Tcl_GetStringFromObj(menuPtr->postedCascade->namePtr,
+ NULL);
/*
* Note: when unposting a submenu, we have to redraw the entire
@@ -969,17 +980,15 @@ TkPostSubmenu(interp, menuPtr, mePtr)
*/
TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
- result = Tcl_VarEval(interp, menuPtr->postedCascade->name,
- " unpost", (char *) NULL);
+ result = Tcl_VarEval(interp, name, " unpost", (char *) NULL);
menuPtr->postedCascade = NULL;
if (result != TCL_OK) {
return result;
}
}
- if ((mePtr != NULL) && (mePtr->name != NULL)
+ 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
@@ -988,10 +997,13 @@ TkPostSubmenu(interp, menuPtr, mePtr)
* 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, mePtr->name, " post ", string,
- (char *) NULL);
+ result = Tcl_VarEval(interp, name, " post ", string, (char *) NULL);
if (result != TCL_OK) {
return result;
}
@@ -1030,10 +1042,16 @@ AdjustMenuCoords(menuPtr, mePtr, xPtr, yPtr, string)
*xPtr += mePtr->x;
*yPtr += mePtr->y + mePtr->height;
} else {
- *xPtr += Tk_Width(menuPtr->tkwin) - menuPtr->borderWidth
- - menuPtr->activeBorderWidth - 2;
- *yPtr += mePtr->y
- + menuPtr->activeBorderWidth + 2;
+ 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/tk/generic/tkMenubutton.c b/tk/generic/tkMenubutton.c
index f7f9c6cb7c1..059499a7d24 100644
--- a/tk/generic/tkMenubutton.c
+++ b/tk/generic/tkMenubutton.c
@@ -18,117 +18,140 @@
#include "default.h"
/*
- * Uids internal to menubuttons.
+ * The following table defines the legal values for the -direction
+ * option. It is used together with the "enum direction" declaration
+ * in tkMenubutton.h.
*/
-static Tk_Uid aboveUid = NULL;
-static Tk_Uid belowUid = NULL;
-static Tk_Uid leftUid = NULL;
-static Tk_Uid rightUid = NULL;
-static Tk_Uid flushUid = NULL;
+static char *directionStrings[] = {
+ "above", "below", "flush", "left", "right", (char *) NULL
+};
+
+/*
+ * The following table defines the legal values for the -state option.
+ * It is used together with the "enum state" declaration in tkMenubutton.h.
+ */
+
+static char *stateStrings[] = {
+ "active", "disabled", "normal", (char *) NULL
+};
/*
* Information used for parsing configuration specs:
*/
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_MENUBUTTON_ACTIVE_BG_COLOR, Tk_Offset(TkMenuButton, activeBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_MENUBUTTON_ACTIVE_BG_MONO, Tk_Offset(TkMenuButton, activeBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_MENUBUTTON_ACTIVE_FG_COLOR, Tk_Offset(TkMenuButton, activeFg),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-activeforeground", "activeForeground", "Background",
- DEF_MENUBUTTON_ACTIVE_FG_MONO, Tk_Offset(TkMenuButton, activeFg),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
- DEF_MENUBUTTON_ANCHOR, Tk_Offset(TkMenuButton, anchor), 0},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_MENUBUTTON_BG_COLOR, Tk_Offset(TkMenuButton, normalBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_MENUBUTTON_BG_MONO, Tk_Offset(TkMenuButton, normalBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
- DEF_MENUBUTTON_BITMAP, Tk_Offset(TkMenuButton, bitmap),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_MENUBUTTON_BORDER_WIDTH, Tk_Offset(TkMenuButton, borderWidth), 0},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_MENUBUTTON_CURSOR, Tk_Offset(TkMenuButton, cursor),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-direction", "direction", "Direction",
- DEF_MENUBUTTON_DIRECTION, Tk_Offset(TkMenuButton, direction),
- 0},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+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,
- Tk_Offset(TkMenuButton, disabledFg),
- TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
- "DisabledForeground", DEF_MENUBUTTON_DISABLED_FG_MONO,
- Tk_Offset(TkMenuButton, disabledFg),
- TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_MENUBUTTON_FONT, Tk_Offset(TkMenuButton, tkfont), 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_MENUBUTTON_FG, Tk_Offset(TkMenuButton, normalFg), 0},
- {TK_CONFIG_STRING, "-height", "height", "Height",
- DEF_MENUBUTTON_HEIGHT, Tk_Offset(TkMenuButton, heightString), 0},
- {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
- "HighlightBackground", DEF_MENUBUTTON_HIGHLIGHT_BG,
- Tk_Offset(TkMenuButton, highlightBgColorPtr), 0},
- {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
- DEF_MENUBUTTON_HIGHLIGHT, Tk_Offset(TkMenuButton, highlightColorPtr),
- 0},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ -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,
- Tk_Offset(TkMenuButton, highlightWidth), 0},
- {TK_CONFIG_STRING, "-image", "image", "Image",
- DEF_MENUBUTTON_IMAGE, Tk_Offset(TkMenuButton, imageString),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
- DEF_MENUBUTTON_INDICATOR, Tk_Offset(TkMenuButton, indicatorOn), 0},
- {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
- DEF_MENUBUTTON_JUSTIFY, Tk_Offset(TkMenuButton, justify), 0},
- {TK_CONFIG_STRING, "-menu", "menu", "Menu",
- DEF_MENUBUTTON_MENU, Tk_Offset(TkMenuButton, menuName),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
- DEF_MENUBUTTON_PADX, Tk_Offset(TkMenuButton, padX), 0},
- {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
- DEF_MENUBUTTON_PADY, Tk_Offset(TkMenuButton, padY), 0},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_MENUBUTTON_RELIEF, Tk_Offset(TkMenuButton, relief), 0},
- {TK_CONFIG_UID, "-state", "state", "State",
- DEF_MENUBUTTON_STATE, Tk_Offset(TkMenuButton, state), 0},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_MENUBUTTON_TAKE_FOCUS, Tk_Offset(TkMenuButton, takeFocus),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_STRING, "-text", "text", "Text",
- DEF_MENUBUTTON_TEXT, Tk_Offset(TkMenuButton, text), 0},
- {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
- DEF_MENUBUTTON_TEXT_VARIABLE, Tk_Offset(TkMenuButton, textVarName),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_INT, "-underline", "underline", "Underline",
- DEF_MENUBUTTON_UNDERLINE, Tk_Offset(TkMenuButton, underline), 0},
- {TK_CONFIG_STRING, "-width", "width", "Width",
- DEF_MENUBUTTON_WIDTH, Tk_Offset(TkMenuButton, widthString), 0},
- {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
- DEF_MENUBUTTON_WRAP_LENGTH, Tk_Offset(TkMenuButton, wrapLength), 0},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ -1, Tk_Offset(TkMenuButton, highlightWidth), 0, 0, 0},
+ {TK_OPTION_STRING, "-image", "image", "Image",
+ DEF_MENUBUTTON_IMAGE, -1, Tk_Offset(TkMenuButton, imageString),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_BOOLEAN, "-indicatoron", "indicatorOn", "IndicatorOn",
+ DEF_MENUBUTTON_INDICATOR, -1, Tk_Offset(TkMenuButton, indicatorOn),
+ 0, 0, 0},
+ {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_BUTTON_JUSTIFY, -1, Tk_Offset(TkMenuButton, justify), 0, 0, 0},
+ {TK_OPTION_STRING, "-menu", "menu", "Menu",
+ DEF_MENUBUTTON_MENU, -1, Tk_Offset(TkMenuButton, menuName),
+ TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_PIXELS, "-padx", "padX", "Pad",
+ DEF_MENUBUTTON_PADX, -1, Tk_Offset(TkMenuButton, padX),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-pady", "padY", "Pad",
+ DEF_MENUBUTTON_PADY, -1, Tk_Offset(TkMenuButton, padY),
+ 0, 0, 0},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ DEF_MENUBUTTON_RELIEF, -1, Tk_Offset(TkMenuButton, relief),
+ 0, 0, 0},
+ {TK_OPTION_STRING_TABLE, "-state", "state", "State",
+ DEF_MENUBUTTON_STATE, -1, Tk_Offset(TkMenuButton, state),
+ 0, (ClientData) stateStrings, 0},
+ {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MENUBUTTON_TAKE_FOCUS, -1,
+ Tk_Offset(TkMenuButton, takeFocus), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_STRING, "-text", "text", "Text",
+ DEF_MENUBUTTON_TEXT, -1, Tk_Offset(TkMenuButton, text), 0, 0, 0},
+ {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MENUBUTTON_TEXT_VARIABLE, -1,
+ Tk_Offset(TkMenuButton, textVarName), TK_OPTION_NULL_OK, 0, 0},
+ {TK_OPTION_INT, "-underline", "underline", "Underline",
+ DEF_MENUBUTTON_UNDERLINE, -1, Tk_Offset(TkMenuButton, underline),
+ 0, 0, 0},
+ {TK_OPTION_STRING, "-width", "width", "Width",
+ DEF_MENUBUTTON_WIDTH, -1, Tk_Offset(TkMenuButton, widthString),
+ 0, 0, 0},
+ {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_MENUBUTTON_WRAP_LENGTH, -1, Tk_Offset(TkMenuButton, wrapLength),
+ 0, 0, 0},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
(char *) NULL, 0, 0}
};
/*
+ * The following tables define the menubutton widget commands and map the
+ * indexes into the string tables into a single enumerated type used
+ * to dispatch the scale widget command.
+ */
+
+static char *commandNames[] = {
+ "cget", "configure", (char *) NULL
+};
+
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE
+};
+
+/*
* Forward declarations for procedures defined later in this file:
*/
@@ -142,17 +165,18 @@ static void MenuButtonImageProc _ANSI_ARGS_((ClientData clientData,
static char * MenuButtonTextVarProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
char *name1, char *name2, int flags));
-static int MenuButtonWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static int 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 argc, char **argv,
- int flags));
+ TkMenuButton *mbPtr, int objc,
+ Tcl_Obj *CONST objv[]));
static void DestroyMenuButton _ANSI_ARGS_((char *memPtr));
/*
*--------------------------------------------------------------
*
- * Tk_MenubuttonCmd --
+ * Tk_MenubuttonObjCmd --
*
* This procedure is invoked to process the "button", "label",
* "radiobutton", and "checkbutton" Tcl commands. See the
@@ -168,20 +192,38 @@ static void DestroyMenuButton _ANSI_ARGS_((char *memPtr));
*/
int
-Tk_MenubuttonCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_MenubuttonObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to
+ * option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register TkMenuButton *mbPtr;
- Tk_Window tkwin = (Tk_Window) clientData;
- Tk_Window new;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ optionTable = (Tk_OptionTable) clientData;
+ if (optionTable == NULL) {
+ Tcl_CmdInfo info;
+ char *name;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ /*
+ * We haven't created the option table for this widget class
+ * yet. Do it now and save the table as the clientData for
+ * the command, so we'll have access to it in future
+ * invocations of the command.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+ name = Tcl_GetString(objv[0]);
+ Tcl_GetCommandInfo(interp, name, &info);
+ info.objClientData = (ClientData) optionTable;
+ Tcl_SetCommandInfo(interp, name, &info);
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
@@ -189,25 +231,28 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv)
* Create the new window.
*/
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
- if (new == NULL) {
+ tkwin = Tk_CreateWindowFromPath(interp,
+ Tk_MainWindow(interp), Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
return TCL_ERROR;
}
- Tk_SetClass(new, "Menubutton");
- mbPtr = TkpCreateMenuButton(new);
+ Tk_SetClass(tkwin, "Menubutton");
+ mbPtr = TkpCreateMenuButton(tkwin);
- TkSetClassProcs(new, &tkpMenubuttonClass, (ClientData) mbPtr);
+ TkSetClassProcs(tkwin, &tkpMenubuttonClass, (ClientData) mbPtr);
/*
* Initialize the data structure for the button.
*/
- mbPtr->tkwin = new;
- mbPtr->display = Tk_Display (new);
+ mbPtr->tkwin = tkwin;
+ mbPtr->display = Tk_Display (tkwin);
mbPtr->interp = interp;
- mbPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(mbPtr->tkwin),
- MenuButtonWidgetCmd, (ClientData) mbPtr, MenuButtonCmdDeletedProc);
+ 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;
@@ -215,7 +260,7 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv)
mbPtr->bitmap = None;
mbPtr->imageString = NULL;
mbPtr->image = NULL;
- mbPtr->state = tkNormalUid;
+ mbPtr->state = STATE_NORMAL;
mbPtr->normalBorder = NULL;
mbPtr->activeBorder = NULL;
mbPtr->borderWidth = 0;
@@ -247,34 +292,35 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv)
mbPtr->indicatorOn = 0;
mbPtr->indicatorWidth = 0;
mbPtr->indicatorHeight = 0;
+ mbPtr->direction = DIRECTION_FLUSH;
mbPtr->cursor = None;
mbPtr->takeFocus = NULL;
mbPtr->flags = 0;
- if (aboveUid == NULL) {
- aboveUid = Tk_GetUid("above");
- belowUid = Tk_GetUid("below");
- leftUid = Tk_GetUid("left");
- rightUid = Tk_GetUid("right");
- flushUid = Tk_GetUid("flush");
- }
- mbPtr->direction = flushUid;
Tk_CreateEventHandler(mbPtr->tkwin,
ExposureMask|StructureNotifyMask|FocusChangeMask,
MenuButtonEventProc, (ClientData) mbPtr);
- if (ConfigureMenuButton(interp, mbPtr, argc-2, argv+2, 0) != TCL_OK) {
+
+ if (Tk_InitOptions(interp, (char *) mbPtr, optionTable, tkwin)
+ != TCL_OK) {
Tk_DestroyWindow(mbPtr->tkwin);
return TCL_ERROR;
}
- interp->result = Tk_PathName(mbPtr->tkwin);
+ 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;
}
/*
*--------------------------------------------------------------
*
- * MenuButtonWidgetCmd --
+ * MenuButtonWidgetObjCmd --
*
* This procedure is invoked to process the Tcl command
* that corresponds to a widget managed by this module.
@@ -290,56 +336,68 @@ Tk_MenubuttonCmd(clientData, interp, argc, argv)
*/
static int
-MenuButtonWidgetCmd(clientData, interp, argc, argv)
+MenuButtonWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about button widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
- int result;
- size_t length;
- int c;
+ int result, index;
+ Tcl_Obj *objPtr;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " option ?arg arg ...?\"", (char *) NULL);
+ 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);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- result = TCL_ERROR;
- } else {
- result = Tk_ConfigureValue(interp, mbPtr->tkwin, configSpecs,
- (char *) mbPtr, argv[2], 0);
+
+ 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;
}
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs,
- (char *) mbPtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, mbPtr->tkwin, configSpecs,
- (char *) mbPtr, argv[2], 0);
- } else {
- result = ConfigureMenuButton(interp, mbPtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
+
+ 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;
}
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be cget or configure",
- (char *) NULL);
- result = TCL_ERROR;
}
Tcl_Release((ClientData) mbPtr);
return result;
+
+ error:
+ Tcl_Release((ClientData) mbPtr);
+ return TCL_ERROR;
}
/*
@@ -348,9 +406,9 @@ MenuButtonWidgetCmd(clientData, interp, argc, argv)
* DestroyMenuButton --
*
* This procedure is invoked to recycle all of the resources
- * associated with a button widget. It is invoked as a
+ * 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 button pending at the time of the deletion.
+ * other use of the menubutton pending at the time of the deletion.
*
* Results:
* None.
@@ -366,6 +424,11 @@ 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
@@ -373,6 +436,7 @@ DestroyMenuButton(memPtr)
* 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,
@@ -387,15 +451,19 @@ DestroyMenuButton(memPtr)
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->disabledGC != None) {
- Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ if (mbPtr->textLayout != NULL) {
+ Tk_FreeTextLayout(mbPtr->textLayout);
}
- Tk_FreeTextLayout(mbPtr->textLayout);
- Tk_FreeOptions(configSpecs, (char *) mbPtr, mbPtr->display, 0);
- ckfree((char *) mbPtr);
+ Tk_FreeConfigOptions((char *) mbPtr, mbPtr->optionTable,
+ mbPtr->tkwin);
+ mbPtr->tkwin = NULL;
+ Tcl_EventuallyFree((ClientData) mbPtr, TCL_DYNAMIC);
}
/*
@@ -409,7 +477,7 @@ DestroyMenuButton(memPtr)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as text string, colors, font,
@@ -420,147 +488,174 @@ DestroyMenuButton(memPtr)
*/
static int
-ConfigureMenuButton(interp, mbPtr, argc, argv, flags)
+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 argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to Tk_ConfigureWidget. */
+ 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. */
{
- int result;
+ Tk_SavedOptions savedOptions;
+ Tcl_Obj *errorResult = NULL;
+ int error;
Tk_Image image;
/*
- * Eliminate any existing trace on variables monitored by the menubutton.
+ * Eliminate any existing trace on variables monitored by the
+ * menubutton.
*/
if (mbPtr->textVarName != NULL) {
- Tcl_UntraceVar(interp, mbPtr->textVarName,
+ Tcl_UntraceVar(interp, mbPtr->textVarName,
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
MenuButtonTextVarProc, (ClientData) mbPtr);
}
- result = Tk_ConfigureWidget(interp, mbPtr->tkwin, configSpecs,
- argc, argv, (char *) mbPtr, flags);
- if (result != TCL_OK) {
- return TCL_ERROR;
- }
-
/*
- * A few options need special processing, such as setting the
- * background from a 3-D border, or filling in complicated
- * defaults that couldn't be specified to Tk_ConfigureWidget.
+ * 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.
*/
- if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {
- Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
- } else {
- Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
- if ((mbPtr->state != tkNormalUid) && (mbPtr->state != tkActiveUid)
- && (mbPtr->state != tkDisabledUid)) {
- Tcl_AppendResult(interp, "bad state value \"", mbPtr->state,
- "\": must be normal, active, or disabled", (char *) NULL);
- mbPtr->state = tkNormalUid;
- return TCL_ERROR;
+ 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);
}
- }
- if ((mbPtr->direction != aboveUid) && (mbPtr->direction != belowUid)
- && (mbPtr->direction != leftUid) && (mbPtr->direction != rightUid)
- && (mbPtr->direction != flushUid)) {
- Tcl_AppendResult(interp, "bad direction value \"", mbPtr->direction,
- "\": must be above, below, left, right, or flush",
- (char *) NULL);
- mbPtr->direction = belowUid;
- return TCL_ERROR;
- }
-
- if (mbPtr->highlightWidth < 0) {
- mbPtr->highlightWidth = 0;
- }
+ /*
+ * 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->padX < 0) {
- mbPtr->padX = 0;
- }
- if (mbPtr->padY < 0) {
- mbPtr->padY = 0;
- }
+ if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->activeBorder);
+ } else {
+ Tk_SetBackgroundFromBorder(mbPtr->tkwin, mbPtr->normalBorder);
+ }
- /*
- * 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->highlightWidth < 0) {
+ mbPtr->highlightWidth = 0;
+ }
- if (mbPtr->imageString != NULL) {
- image = Tk_GetImage(mbPtr->interp, mbPtr->tkwin,
- mbPtr->imageString, MenuButtonImageProc, (ClientData) mbPtr);
- if (image == NULL) {
- return TCL_ERROR;
+ if (mbPtr->padX < 0) {
+ mbPtr->padX = 0;
+ }
+ if (mbPtr->padY < 0) {
+ mbPtr->padY = 0;
}
- } else {
- image = NULL;
- }
- if (mbPtr->image != NULL) {
- Tk_FreeImage(mbPtr->image);
- }
- mbPtr->image = image;
- if ((mbPtr->image == NULL) && (mbPtr->bitmap == None)
- && (mbPtr->textVarName != NULL)) {
/*
- * The menubutton displays a variable. Set up a trace to watch
- * for any changes in it.
+ * 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.
*/
- char *value;
+ 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;
- value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
- if (value == NULL) {
- Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
- TCL_GLOBAL_ONLY);
+ /*
+ * 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 (mbPtr->text != NULL) {
- ckfree(mbPtr->text);
+ if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
+ != TCL_OK) {
+ goto widthError;
+ }
+ if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
+ != TCL_OK) {
+ goto heightError;
}
- 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);
+ break;
}
- /*
- * Recompute the geometry for the button.
- */
+ if (!error) {
+ Tk_FreeSavedOptions(&savedOptions);
+ }
- if ((mbPtr->bitmap != None) || (mbPtr->image != NULL)) {
- if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->widthString,
- &mbPtr->width) != TCL_OK) {
- widthError:
- Tcl_AddErrorInfo(interp, "\n (processing -width option)");
- return TCL_ERROR;
- }
- if (Tk_GetPixels(interp, mbPtr->tkwin, mbPtr->heightString,
- &mbPtr->height) != TCL_OK) {
- heightError:
- Tcl_AddErrorInfo(interp, "\n (processing -height option)");
- return TCL_ERROR;
- }
- } else {
- if (Tcl_GetInt(interp, mbPtr->widthString, &mbPtr->width)
- != TCL_OK) {
- goto widthError;
- }
- if (Tcl_GetInt(interp, mbPtr->heightString, &mbPtr->height)
- != TCL_OK) {
- goto heightError;
- }
+ if ((mbPtr->image == NULL) && (mbPtr->bitmap == None)
+ && (mbPtr->textVarName != NULL)) {
+
+ /*
+ * The menubutton displays the value of a variable.
+ * Set up a trace to watch for any changes in it, create
+ * the variable if it doesn't exist, and fetch its
+ * current value.
+ */
+
+ char *value;
+
+ value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar(interp, mbPtr->textVarName, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(mbPtr->text, value);
+ }
+ Tcl_TraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, (ClientData) mbPtr);
}
+
TkMenuButtonWorldChanged((ClientData) mbPtr);
- return TCL_OK;
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
}
/*
@@ -605,8 +700,7 @@ TkMenuButtonWorldChanged(instanceData)
gcValues.graphics_exposures = False;
mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
- gc = Tk_GetGCColor(mbPtr->tkwin, mask, &gcValues, mbPtr->normalFg,
- Tk_3DBorderColor(mbPtr->normalBorder));
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
if (mbPtr->normalTextGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
}
@@ -616,8 +710,7 @@ TkMenuButtonWorldChanged(instanceData)
gcValues.foreground = mbPtr->activeFg->pixel;
gcValues.background = Tk_3DBorderColor(mbPtr->activeBorder)->pixel;
mask = GCForeground | GCBackground | GCFont;
- gc = Tk_GetGCColor(mbPtr->tkwin, mask, &gcValues, mbPtr->activeFg,
- Tk_3DBorderColor(mbPtr->activeBorder));
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
if (mbPtr->activeTextGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
}
@@ -627,11 +720,11 @@ TkMenuButtonWorldChanged(instanceData)
background = Tk_3DBorderColor(mbPtr->normalBorder);
gcValues.background = background->pixel;
if ((mbPtr->disabledFg != NULL) && (mbPtr->imageString == NULL)) {
- foreground = mbPtr->disabledFg;
+ foreground = mbPtr->disabledFg;
gcValues.foreground = foreground->pixel;
mask = GCForeground | GCBackground | GCFont;
} else {
- foreground = background;
+ foreground = background;
background = NULL;
gcValues.foreground = gcValues.background;
mask = GCForeground;
@@ -645,7 +738,7 @@ TkMenuButtonWorldChanged(instanceData)
mask |= GCFillStyle | GCStipple;
}
}
- gc = Tk_GetGCColor(mbPtr->tkwin, mask, &gcValues, foreground, background);
+ gc = Tk_GetGC(mbPtr->tkwin, mask, &gcValues);
if (mbPtr->disabledGC != None) {
Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
}
@@ -697,15 +790,7 @@ MenuButtonEventProc(clientData, eventPtr)
goto redraw;
} else if (eventPtr->type == DestroyNotify) {
- TkpDestroyMenuButton(mbPtr);
- if (mbPtr->tkwin != NULL) {
- mbPtr->tkwin = NULL;
- Tcl_DeleteCommandFromToken(mbPtr->interp, mbPtr->widgetCmd);
- }
- if (mbPtr->flags & REDRAW_PENDING) {
- Tcl_CancelIdleCall(TkpDisplayMenuButton, (ClientData) mbPtr);
- }
- Tcl_EventuallyFree((ClientData) mbPtr, DestroyMenuButton);
+ DestroyMenuButton((char *) mbPtr);
} else if (eventPtr->type == FocusIn) {
if (eventPtr->xfocus.detail != NotifyInferior) {
mbPtr->flags |= GOT_FOCUS;
@@ -763,7 +848,6 @@ MenuButtonCmdDeletedProc(clientData)
*/
if (tkwin != NULL) {
- mbPtr->tkwin = NULL;
Tk_DestroyWindow(tkwin);
}
}
@@ -870,3 +954,4 @@ MenuButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
}
}
}
+
diff --git a/tk/generic/tkMenubutton.h b/tk/generic/tkMenubutton.h
index b2382c6bde6..2bca6431e73 100644
--- a/tk/generic/tkMenubutton.h
+++ b/tk/generic/tkMenubutton.h
@@ -25,6 +25,23 @@
#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:
*/
@@ -39,6 +56,8 @@ typedef struct {
* 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. */
@@ -65,7 +84,7 @@ typedef struct {
* Information used when displaying widget:
*/
- Tk_Uid state; /* State of button for display purposes:
+ 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
@@ -143,7 +162,7 @@ typedef struct {
* Miscellaneous information:
*/
- Tk_Uid direction; /* Direction for where to pop the menu.
+ 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
@@ -213,3 +232,4 @@ EXTERN void TkMenuButtonWorldChanged _ANSI_ARGS_((
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKMENUBUTTON */
+
diff --git a/tk/generic/tkMessage.c b/tk/generic/tkMessage.c
index e1313bb6bff..eabffe0197c 100644
--- a/tk/generic/tkMessage.c
+++ b/tk/generic/tkMessage.c
@@ -6,7 +6,7 @@
* in a window according to a particular aspect ratio.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -40,7 +40,7 @@ typedef struct {
char *string; /* String displayed in message. */
int numChars; /* Number of characters in string, not
- * including terminating NULL character. */
+ * including terminating NULL. */
char *textVarName; /* Name of variable (malloc'ed) or NULL.
* If non-NULL, message displays the contents
* of this variable. */
@@ -274,7 +274,7 @@ Tk_MessageCmd(clientData, interp, argc, argv)
goto error;
}
- interp->result = Tk_PathName(msgPtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(msgPtr->tkwin), TCL_STATIC);
return TCL_OK;
error:
@@ -401,7 +401,7 @@ DestroyMessage(memPtr)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as text string, colors, font,
@@ -465,9 +465,7 @@ ConfigureMessage(interp, msgPtr, argc, argv, flags)
* that couldn't be specified to Tk_ConfigureWidget.
*/
- msgPtr->numChars = strlen(msgPtr->string);
-
- Tk_SetBackgroundFromBorder(msgPtr->tkwin, msgPtr->border);
+ msgPtr->numChars = Tcl_NumUtfChars(msgPtr->string, -1);
if (msgPtr->highlightWidth < 0) {
msgPtr->highlightWidth = 0;
@@ -500,16 +498,19 @@ MessageWorldChanged(instanceData)
ClientData instanceData; /* Information about widget. */
{
XGCValues gcValues;
- GC gc;
+ 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_GetGCColor(msgPtr->tkwin, GCForeground | GCFont, &gcValues,
- msgPtr->fgColorPtr, NULL);
+ gc = Tk_GetGC(msgPtr->tkwin, GCForeground | GCFont, &gcValues);
if (msgPtr->textGC != None) {
Tk_FreeGC(msgPtr->display, msgPtr->textGC);
}
@@ -645,13 +646,23 @@ DisplayMessage(clientData)
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;
}
- Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border, 0, 0,
- Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+ 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
@@ -663,7 +674,7 @@ DisplayMessage(clientData)
Tk_DrawTextLayout(Tk_Display(tkwin), Tk_WindowId(tkwin), msgPtr->textGC,
msgPtr->textLayout, x, y, 0, -1);
- if (msgPtr->relief != TK_RELIEF_FLAT) {
+ if (borderWidth > msgPtr->highlightWidth) {
Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border,
msgPtr->highlightWidth, msgPtr->highlightWidth,
Tk_Width(tkwin) - 2*msgPtr->highlightWidth,
@@ -671,15 +682,17 @@ DisplayMessage(clientData)
msgPtr->borderWidth, msgPtr->relief);
}
if (msgPtr->highlightWidth != 0) {
- GC gc;
+ GC fgGC, bgGC;
+ bgGC = Tk_GCForColor(msgPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
if (msgPtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(msgPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ fgGC = Tk_GCForColor(msgPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
} else {
- gc = Tk_GCForColor(msgPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
}
- Tk_DrawFocusHighlight(tkwin, gc, msgPtr->highlightWidth,
- Tk_WindowId(tkwin));
}
}
@@ -835,8 +848,8 @@ MessageTextVarProc(clientData, interp, name1, name2, flags)
if (msgPtr->string != NULL) {
ckfree(msgPtr->string);
}
- msgPtr->numChars = strlen(value);
- msgPtr->string = (char *) ckalloc((unsigned) (msgPtr->numChars + 1));
+ msgPtr->numChars = Tcl_NumUtfChars(value, -1);
+ msgPtr->string = (char *) ckalloc((unsigned) (strlen(value) + 1));
strcpy(msgPtr->string, value);
ComputeMessageGeometry(msgPtr);
@@ -847,3 +860,4 @@ MessageTextVarProc(clientData, interp, name1, name2, flags)
}
return (char *) NULL;
}
+
diff --git a/tk/generic/tkObj.c b/tk/generic/tkObj.c
new file mode 100644
index 00000000000..071cb383f43
--- /dev/null
+++ b/tk/generic/tkObj.c
@@ -0,0 +1,660 @@
+/*
+ * 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;
+
+/*
+ * Prototypes for procedures defined later in this file:
+ */
+
+static void DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static int SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static int SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * The following structure defines the implementation of the "pixel"
+ * Tcl object, used for measuring distances. The pixel object remembers
+ * its initial display-independant settings.
+ */
+
+static Tcl_ObjType pixelObjType = {
+ "pixel", /* name */
+ FreePixelInternalRep, /* freeIntRepProc */
+ DupPixelInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetPixelFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "pixel"
+ * Tcl object, used for measuring distances. The pixel object remembers
+ * its initial display-independant settings.
+ */
+
+static Tcl_ObjType mmObjType = {
+ "mm", /* name */
+ FreeMMInternalRep, /* freeIntRepProc */
+ DupMMInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetMMFromAny /* setFromAnyProc */
+};
+
+/*
+ * The following structure defines the implementation of the "window"
+ * Tcl object.
+ */
+
+static Tcl_ObjType windowObjType = {
+ "window", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetWindowFromAny /* setFromAnyProc */
+};
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixelsFromObj --
+ *
+ * Attempt to return a pixel value from the Tcl object "objPtr". If the
+ * object is not already a pixel value, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a pixel, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetPixelsFromObj(interp, tkwin, objPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get pixels. */
+ int *intPtr; /* Place to store resulting pixels. */
+{
+ int result;
+ double d;
+ PixelRep *pixelPtr;
+ static double bias[] = {
+ 1.0, 10.0, 25.4, 25.4 / 72.0
+ };
+
+ if (objPtr->typePtr != &pixelObjType) {
+ result = SetPixelFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ if (SIMPLE_PIXELREP(objPtr)) {
+ *intPtr = GET_SIMPLEPIXEL(objPtr);
+ } else {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ if (pixelPtr->tkwin != tkwin) {
+ d = pixelPtr->value;
+ if (pixelPtr->units >= 0) {
+ d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ }
+ if (d < 0) {
+ pixelPtr->returnValue = (int) (d - 0.5);
+ } else {
+ pixelPtr->returnValue = (int) (d + 0.5);
+ }
+ pixelPtr->tkwin = tkwin;
+ }
+ *intPtr = pixelPtr->returnValue;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreePixelInternalRep --
+ *
+ * Deallocate the storage associated with a pixel object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreePixelInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* Pixel object with internal rep to free. */
+{
+ PixelRep *pixelPtr;
+
+ if (!SIMPLE_PIXELREP(objPtr)) {
+ pixelPtr = GET_COMPLEXPIXEL(objPtr);
+ ckfree((char *) pixelPtr);
+ }
+ SET_SIMPLEPIXEL(objPtr, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupPixelInternalRep --
+ *
+ * Initialize the internal representation of a pixel Tcl_Obj to a
+ * copy of the internal representation of an existing pixel object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to the pixel corresponding to
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupPixelInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ PixelRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+
+ if (SIMPLE_PIXELREP(srcPtr)) {
+ SET_SIMPLEPIXEL(copyPtr, GET_SIMPLEPIXEL(srcPtr));
+ } else {
+ oldPtr = GET_COMPLEXPIXEL(srcPtr);
+ newPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ SET_COMPLEXPIXEL(copyPtr, newPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetPixelFromAny --
+ *
+ * Attempt to generate a pixel internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a pixel representation of the object is
+ * stored internally and the type of "objPtr" is set to pixel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetPixelFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *string, *rest;
+ double d;
+ int i, units;
+ PixelRep *pixelPtr;
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to pixels.
+ */
+
+ char buf[100];
+
+ error:
+ sprintf(buf, "bad screen distance \"%.50s\"", string);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_ERROR;
+ }
+ while ((*rest != '\0') && isspace(UCHAR(*rest))) {
+ rest++;
+ }
+ switch (*rest) {
+ case '\0':
+ units = -1;
+ break;
+
+ case 'm':
+ units = 0;
+ break;
+
+ case 'c':
+ units = 1;
+ break;
+
+ case 'i':
+ units = 2;
+ break;
+
+ case 'p':
+ units = 3;
+ break;
+
+ default:
+ goto error;
+ }
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &pixelObjType;
+
+ i = (int) d;
+ if ((units < 0) && (i == d)) {
+ SET_SIMPLEPIXEL(objPtr, i);
+ } else {
+ pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));
+ pixelPtr->value = d;
+ pixelPtr->units = units;
+ pixelPtr->tkwin = NULL;
+ pixelPtr->returnValue = i;
+ SET_COMPLEXPIXEL(objPtr, pixelPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetMMFromObj --
+ *
+ * Attempt to return an mm value from the Tcl object "objPtr". If the
+ * object is not already an mm value, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a pixel, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetMMFromObj(interp, tkwin, objPtr, doublePtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin;
+ Tcl_Obj *objPtr; /* The object from which to get mms. */
+ double *doublePtr; /* Place to store resulting millimeters. */
+{
+ int result;
+ double d;
+ MMRep *mmPtr;
+ static double bias[] = {
+ 10.0, 25.4, 1.0, 25.4 / 72.0
+ };
+
+ if (objPtr->typePtr != &mmObjType) {
+ result = SetMMFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+ if (mmPtr->tkwin != tkwin) {
+ d = mmPtr->value;
+ if (mmPtr->units == -1) {
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ } else {
+ d *= bias[mmPtr->units];
+ }
+ mmPtr->tkwin = tkwin;
+ mmPtr->returnValue = d;
+ }
+ *doublePtr = mmPtr->returnValue;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMMInternalRep --
+ *
+ * Deallocate the storage associated with a mm object's internal
+ * representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees objPtr's internal representation and sets objPtr's
+ * internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMMInternalRep(objPtr)
+ Tcl_Obj *objPtr; /* MM object with internal rep to free. */
+{
+ ckfree((char *) objPtr->internalRep.otherValuePtr);
+ objPtr->internalRep.otherValuePtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupMMInternalRep --
+ *
+ * Initialize the internal representation of a pixel Tcl_Obj to a
+ * copy of the internal representation of an existing pixel object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to the pixel corresponding to
+ * srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupMMInternalRep(srcPtr, copyPtr)
+ register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ MMRep *oldPtr, *newPtr;
+
+ copyPtr->typePtr = srcPtr->typePtr;
+ oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
+ newPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ newPtr->value = oldPtr->value;
+ newPtr->units = oldPtr->units;
+ newPtr->tkwin = oldPtr->tkwin;
+ newPtr->returnValue = oldPtr->returnValue;
+ copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMMFromAny --
+ *
+ * Attempt to generate a mm internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a mm representation of the object is
+ * stored internally and the type of "objPtr" is set to mm.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetMMFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+ char *string, *rest;
+ double d;
+ int units;
+ MMRep *mmPtr;
+
+ string = Tcl_GetStringFromObj(objPtr, NULL);
+
+ d = strtod(string, &rest);
+ if (rest == string) {
+ /*
+ * Must copy string before resetting the result in case a caller
+ * is trying to convert the interpreter's result to mms.
+ */
+
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*rest != '\0') && isspace(UCHAR(*rest))) {
+ rest++;
+ }
+ switch (*rest) {
+ case '\0':
+ units = -1;
+ break;
+
+ case 'c':
+ units = 0;
+ break;
+
+ case 'i':
+ units = 1;
+ break;
+
+ case 'm':
+ units = 2;
+ break;
+
+ case 'p':
+ units = 3;
+ break;
+
+ default:
+ goto error;
+ }
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+
+ objPtr->typePtr = &mmObjType;
+
+ mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ mmPtr->value = d;
+ mmPtr->units = units;
+ mmPtr->tkwin = NULL;
+ mmPtr->returnValue = d;
+ objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetWindowFromObj --
+ *
+ * Attempt to return a Tk_Window from the Tcl object "objPtr". If the
+ * object is not already a Tk_Window, an attempt will be made to convert
+ * it to one.
+ *
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
+ *
+ * Side effects:
+ * If the object is not already a Tk_Window, the conversion will free
+ * any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ Tk_Window tkwin; /* A token to get the main window from. */
+ register Tcl_Obj *objPtr; /* The object from which to get boolean. */
+ Tk_Window *windowPtr; /* Place to store resulting window. */
+{
+ register int result;
+ Tk_Window lastWindow;
+
+ result = SetWindowFromAny(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;
+ if (tkwin != lastWindow) {
+ Tk_Window foundWindow = Tk_NameToWindow(interp,
+ Tcl_GetStringFromObj(objPtr, NULL), tkwin);
+
+ if (foundWindow == NULL) {
+ return TCL_ERROR;
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;
+ }
+ *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetWindowFromAny --
+ *
+ * Attempt to generate a Tk_Window internal form for the Tcl object
+ * "objPtr".
+ *
+ * Results:
+ * The return value is a standard Tcl result. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
+ *
+ * Side effects:
+ * If no error occurs, a standard window value is stored as "objPtr"s
+ * internal representation and the type of "objPtr" is set to Tk_Window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetWindowFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Used for error reporting if not NULL. */
+ register Tcl_Obj *objPtr; /* The object to convert. */
+{
+ Tcl_ObjType *typePtr;
+
+ /*
+ * Free the old internalRep before setting the new one.
+ */
+
+ Tcl_GetStringFromObj(objPtr, NULL);
+ typePtr = objPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->typePtr = &windowObjType;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+
+ return TCL_OK;
+}
+
diff --git a/tk/generic/tkOldConfig.c b/tk/generic/tkOldConfig.c
new file mode 100644
index 00000000000..18b22e451ee
--- /dev/null
+++ b/tk/generic/tkOldConfig.c
@@ -0,0 +1,1023 @@
+/*
+ * 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, char *argvName,
+ int needFlags, int hateFlags));
+static char * FormatConfigInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ char *widgRec));
+static char * FormatConfigValue _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, Tk_ConfigSpec *specPtr,
+ char *widgRec, char *buffer,
+ Tcl_FreeProc **freeProcPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigureWidget --
+ *
+ * Process command-line options and database options to
+ * fill in fields of a widget record with resources and
+ * other parameters.
+ *
+ * Results:
+ * A standard Tcl return value. In case of an error,
+ * the interp's result will hold an error message.
+ *
+ * Side effects:
+ * The fields of widgRec get filled in with information
+ * from argc/argv and the option database. Old information
+ * in widgRec's fields gets recycled.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureWidget(interp, tkwin, specs, argc, argv, widgRec, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window containing widget (needed to
+ * set up X resources). */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Command-line options. */
+ char *widgRec; /* Record whose fields are to be
+ * modified. Values must be properly
+ * initialized. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. Also,
+ * may have TK_CONFIG_ARGV_ONLY set. */
+{
+ register Tk_ConfigSpec *specPtr;
+ Tk_Uid value; /* Value of option from database. */
+ int needFlags; /* Specs must contain this set of flags
+ * or else they are not considered. */
+ int hateFlags; /* If a spec contains any bits here, it's
+ * not considered. */
+
+ 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) {
+ 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. */
+ char *argvName; /* Name (suitable for use in a "config"
+ * command) identifying particular option. */
+ int needFlags; /* Flags that must be present in matching
+ * entry. */
+ int hateFlags; /* Flags that must NOT be present in
+ * matching entry. */
+{
+ register Tk_ConfigSpec *specPtr;
+ register char c; /* First character of current argument. */
+ Tk_ConfigSpec *matchPtr; /* Matching spec, or NULL. */
+ size_t length;
+
+ c = argvName[1];
+ length = strlen(argvName);
+ matchPtr = NULL;
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+ if ((specPtr->argvName[1] != c)
+ || (strncmp(specPtr->argvName, argvName, length) != 0)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ if (specPtr->argvName[length] == 0) {
+ matchPtr = specPtr;
+ goto gotMatch;
+ }
+ if (matchPtr != NULL) {
+ Tcl_AppendResult(interp, "ambiguous option \"", argvName,
+ "\"", (char *) NULL);
+ return (Tk_ConfigSpec *) NULL;
+ }
+ matchPtr = specPtr;
+ }
+
+ if (matchPtr == NULL) {
+ Tcl_AppendResult(interp, "unknown option \"", argvName,
+ "\"", (char *) NULL);
+ return (Tk_ConfigSpec *) NULL;
+ }
+
+ /*
+ * Found a matching entry. If it's a synonym, then find the
+ * entry that it's a synonym for.
+ */
+
+ gotMatch:
+ specPtr = matchPtr;
+ if (specPtr->type == TK_CONFIG_SYNONYM) {
+ for (specPtr = specs; ; specPtr++) {
+ if (specPtr->type == TK_CONFIG_END) {
+ Tcl_AppendResult(interp,
+ "couldn't find synonym for option \"",
+ argvName, "\"", (char *) NULL);
+ return (Tk_ConfigSpec *) NULL;
+ }
+ if ((specPtr->dbName == matchPtr->dbName)
+ && (specPtr->type != TK_CONFIG_SYNONYM)
+ && ((specPtr->specFlags & needFlags) == needFlags)
+ && !(specPtr->specFlags & hateFlags)) {
+ break;
+ }
+ }
+ }
+ return specPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DoConfig --
+ *
+ * This procedure applies a single configuration option
+ * to a widget record.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * WidgRec is modified as indicated by specPtr and value.
+ * The old value is recycled, if that is appropriate for
+ * the value type.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DoConfig(interp, tkwin, specPtr, value, valueIsUid, widgRec)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window containing widget (needed to
+ * set up X resources). */
+ Tk_ConfigSpec *specPtr; /* Specifier to apply. */
+ char *value; /* Value to use to fill in widgRec. */
+ int valueIsUid; /* Non-zero means value is a Tk_Uid;
+ * zero means it's an ordinary string. */
+ char *widgRec; /* Record whose fields are to be
+ * modified. Values must be properly
+ * initialized. */
+{
+ char *ptr;
+ Tk_Uid uid;
+ int nullValue;
+
+ nullValue = 0;
+ if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
+ nullValue = 1;
+ }
+
+ do {
+ ptr = widgRec + specPtr->offset;
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_INT:
+ if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_DOUBLE:
+ if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_STRING: {
+ char *old, *new;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ new = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(new, value);
+ }
+ old = *((char **) ptr);
+ if (old != NULL) {
+ ckfree(old);
+ }
+ *((char **) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_UID:
+ if (nullValue) {
+ *((Tk_Uid *) ptr) = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ *((Tk_Uid *) ptr) = uid;
+ }
+ break;
+ case TK_CONFIG_COLOR: {
+ XColor *newPtr, *oldPtr;
+
+ if (nullValue) {
+ newPtr = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ newPtr = Tk_GetColor(interp, tkwin, uid);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ oldPtr = *((XColor **) ptr);
+ if (oldPtr != NULL) {
+ Tk_FreeColor(oldPtr);
+ }
+ *((XColor **) ptr) = newPtr;
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font new;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ new = Tk_GetFont(interp, tkwin, value);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_FreeFont(*((Tk_Font *) ptr));
+ *((Tk_Font *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap new, old;
+
+ if (nullValue) {
+ new = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_GetBitmap(interp, tkwin, uid);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Pixmap *) ptr);
+ if (old != None) {
+ Tk_FreeBitmap(Tk_Display(tkwin), old);
+ }
+ *((Pixmap *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder new, old;
+
+ if (nullValue) {
+ new = NULL;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_Get3DBorder(interp, tkwin, uid);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Tk_3DBorder *) ptr);
+ if (old != NULL) {
+ Tk_Free3DBorder(old);
+ }
+ *((Tk_3DBorder *) ptr) = new;
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor new, old;
+
+ if (nullValue) {
+ new = None;
+ } else {
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ new = Tk_GetCursor(interp, tkwin, uid);
+ if (new == None) {
+ return TCL_ERROR;
+ }
+ }
+ old = *((Tk_Cursor *) ptr);
+ if (old != None) {
+ Tk_FreeCursor(Tk_Display(tkwin), old);
+ }
+ *((Tk_Cursor *) ptr) = new;
+ if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
+ Tk_DefineCursor(tkwin, new);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_ANCHOR:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
+ if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_PIXELS:
+ if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_MM:
+ if (Tk_GetScreenMM(interp, tkwin, value, (double *) ptr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin2;
+
+ if (nullValue) {
+ tkwin2 = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, value, tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ *((Tk_Window *) ptr) = tkwin2;
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ if ((*specPtr->customPtr->parseProc)(
+ specPtr->customPtr->clientData, interp, tkwin,
+ value, widgRec, specPtr->offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ default: {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad config table: unknown type %d",
+ specPtr->type);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ specPtr++;
+ } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ConfigureInfo --
+ *
+ * Return information about the configuration options
+ * for a window, and their current values.
+ *
+ * Results:
+ * Always returns TCL_OK. The interp's result will be modified
+ * hold a description of either a single configuration option
+ * available for "widgRec" via "specs", or all the configuration
+ * options available. In the "all" case, the result will
+ * available for "widgRec" via "specs". The result will
+ * be a list, each of whose entries describes one option.
+ * Each entry will itself be a list containing the option's
+ * name for use on command lines, database name, database
+ * class, default value, and current value (empty string
+ * if none). For options that are synonyms, the list will
+ * contain only two values: name and synonym name. If the
+ * "name" argument is non-NULL, then the only information
+ * returned is that for the named argument (i.e. the corresponding
+ * entry in the overall list is returned).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureInfo(interp, tkwin, specs, widgRec, argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ char *argvName; /* If non-NULL, indicates a single option
+ * whose info is to be returned. Otherwise
+ * info is returned for all options. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ register Tk_ConfigSpec *specPtr;
+ int needFlags, hateFlags;
+ char *list;
+ char *leader = "{";
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+
+ /*
+ * If information is only wanted for a single configuration
+ * spec, then handle that one spec specially.
+ */
+
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ if (argvName != NULL) {
+ specPtr = FindConfigSpec(interp, specs, argvName, needFlags,
+ hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp,
+ FormatConfigInfo(interp, tkwin, specPtr, widgRec),
+ TCL_DYNAMIC);
+ return TCL_OK;
+ }
+
+ /*
+ * Loop through all the specs, creating a big list with all
+ * their information.
+ */
+
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((argvName != NULL) && (specPtr->argvName != argvName)) {
+ continue;
+ }
+ if (((specPtr->specFlags & needFlags) != needFlags)
+ || (specPtr->specFlags & hateFlags)) {
+ continue;
+ }
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+ list = FormatConfigInfo(interp, tkwin, specPtr, widgRec);
+ Tcl_AppendResult(interp, leader, list, "}", (char *) NULL);
+ ckfree(list);
+ leader = " {";
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FormatConfigInfo --
+ *
+ * Create a valid Tcl list holding the configuration information
+ * for a single configuration option.
+ *
+ * Results:
+ * A Tcl list, dynamically allocated. The caller is expected to
+ * arrange for this list to be freed eventually.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+FormatConfigInfo(interp, tkwin, specPtr, widgRec)
+ Tcl_Interp *interp; /* Interpreter to use for things
+ * like floating-point precision. */
+ Tk_Window tkwin; /* Window corresponding to widget. */
+ register Tk_ConfigSpec *specPtr; /* Pointer to information describing
+ * option. */
+ char *widgRec; /* Pointer to record holding current
+ * values of info for widget. */
+{
+ char *argv[6], *result;
+ char buffer[200];
+ Tcl_FreeProc *freeProc = (Tcl_FreeProc *) NULL;
+
+ argv[0] = specPtr->argvName;
+ argv[1] = specPtr->dbName;
+ argv[2] = specPtr->dbClass;
+ argv[3] = specPtr->defValue;
+ if (specPtr->type == TK_CONFIG_SYNONYM) {
+ return Tcl_Merge(2, argv);
+ }
+ argv[4] = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
+ &freeProc);
+ if (argv[1] == NULL) {
+ argv[1] = "";
+ }
+ if (argv[2] == NULL) {
+ argv[2] = "";
+ }
+ if (argv[3] == NULL) {
+ argv[3] = "";
+ }
+ if (argv[4] == NULL) {
+ argv[4] = "";
+ }
+ result = Tcl_Merge(5, argv);
+ if (freeProc != NULL) {
+ if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
+ ckfree(argv[4]);
+ } else {
+ (*freeProc)(argv[4]);
+ }
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatConfigValue --
+ *
+ * This procedure formats the current value of a configuration
+ * option.
+ *
+ * Results:
+ * The return value is the formatted value of the option given
+ * by specPtr and widgRec. If the value is static, so that it
+ * need not be freed, *freeProcPtr will be set to NULL; otherwise
+ * *freeProcPtr will be set to the address of a procedure to
+ * free the result, and the caller must invoke this procedure
+ * when it is finished with the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer, freeProcPtr)
+ Tcl_Interp *interp; /* Interpreter for use in real conversions. */
+ Tk_Window tkwin; /* Window corresponding to widget. */
+ Tk_ConfigSpec *specPtr; /* Pointer to information describing option.
+ * Must not point to a synonym option. */
+ char *widgRec; /* Pointer to record holding current
+ * values of info for widget. */
+ char *buffer; /* Static buffer to use for small values.
+ * Must have at least 200 bytes of storage. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to word to fill in with address
+ * of procedure to free the result, or NULL
+ * if result is static. */
+{
+ char *ptr, *result;
+
+ *freeProcPtr = NULL;
+ ptr = widgRec + specPtr->offset;
+ result = "";
+ switch (specPtr->type) {
+ case TK_CONFIG_BOOLEAN:
+ if (*((int *) ptr) == 0) {
+ result = "0";
+ } else {
+ result = "1";
+ }
+ break;
+ case TK_CONFIG_INT:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_DOUBLE:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_STRING:
+ result = (*(char **) ptr);
+ if (result == NULL) {
+ result = "";
+ }
+ break;
+ case TK_CONFIG_UID: {
+ Tk_Uid uid = *((Tk_Uid *) ptr);
+ if (uid != NULL) {
+ result = uid;
+ }
+ break;
+ }
+ case TK_CONFIG_COLOR: {
+ XColor *colorPtr = *((XColor **) ptr);
+ if (colorPtr != NULL) {
+ result = Tk_NameOfColor(colorPtr);
+ }
+ break;
+ }
+ case TK_CONFIG_FONT: {
+ Tk_Font tkfont = *((Tk_Font *) ptr);
+ if (tkfont != NULL) {
+ result = Tk_NameOfFont(tkfont);
+ }
+ break;
+ }
+ case TK_CONFIG_BITMAP: {
+ Pixmap pixmap = *((Pixmap *) ptr);
+ if (pixmap != None) {
+ result = Tk_NameOfBitmap(Tk_Display(tkwin), pixmap);
+ }
+ break;
+ }
+ case TK_CONFIG_BORDER: {
+ Tk_3DBorder border = *((Tk_3DBorder *) ptr);
+ if (border != NULL) {
+ result = Tk_NameOf3DBorder(border);
+ }
+ break;
+ }
+ case TK_CONFIG_RELIEF:
+ result = Tk_NameOfRelief(*((int *) ptr));
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR: {
+ Tk_Cursor cursor = *((Tk_Cursor *) ptr);
+ if (cursor != None) {
+ result = Tk_NameOfCursor(Tk_Display(tkwin), cursor);
+ }
+ break;
+ }
+ case TK_CONFIG_JUSTIFY:
+ result = Tk_NameOfJustify(*((Tk_Justify *) ptr));
+ break;
+ case TK_CONFIG_ANCHOR:
+ result = Tk_NameOfAnchor(*((Tk_Anchor *) ptr));
+ break;
+ case TK_CONFIG_CAP_STYLE:
+ result = Tk_NameOfCapStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_JOIN_STYLE:
+ result = Tk_NameOfJoinStyle(*((int *) ptr));
+ break;
+ case TK_CONFIG_PIXELS:
+ sprintf(buffer, "%d", *((int *) ptr));
+ result = buffer;
+ break;
+ case TK_CONFIG_MM:
+ Tcl_PrintDouble(interp, *((double *) ptr), buffer);
+ result = buffer;
+ break;
+ case TK_CONFIG_WINDOW: {
+ Tk_Window tkwin;
+
+ tkwin = *((Tk_Window *) ptr);
+ if (tkwin != NULL) {
+ result = Tk_PathName(tkwin);
+ }
+ break;
+ }
+ case TK_CONFIG_CUSTOM:
+ result = (*specPtr->customPtr->printProc)(
+ specPtr->customPtr->clientData, tkwin, widgRec,
+ specPtr->offset, freeProcPtr);
+ break;
+ default:
+ result = "?? unknown type ??";
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ConfigureValue --
+ *
+ * This procedure returns the current value of a configuration
+ * option for a widget.
+ *
+ * Results:
+ * The return value is a standard Tcl completion code (TCL_OK or
+ * TCL_ERROR). The interp's result will be set to hold either the value
+ * of the option given by argvName (if TCL_OK is returned) or
+ * an error message (if TCL_ERROR is returned).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ConfigureValue(interp, tkwin, specs, widgRec, argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ char *argvName; /* Gives the command-line name for the
+ * option whose value is to be returned. */
+ int flags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ Tk_ConfigSpec *specPtr;
+ int needFlags, hateFlags;
+
+ needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
+ if (Tk_Depth(tkwin) <= 1) {
+ hateFlags = TK_CONFIG_COLOR_ONLY;
+ } else {
+ hateFlags = TK_CONFIG_MONO_ONLY;
+ }
+ specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
+ if (specPtr == NULL) {
+ return TCL_ERROR;
+ }
+ interp->result = FormatConfigValue(interp, tkwin, specPtr, widgRec,
+ interp->result, &interp->freeProc);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeOptions --
+ *
+ * Free up all resources associated with configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any resource in widgRec that is controlled by a configuration
+ * option (e.g. a Tk_3DBorder or XColor) is freed in the appropriate
+ * fashion.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+Tk_FreeOptions(specs, widgRec, display, needFlags)
+ Tk_ConfigSpec *specs; /* Describes legal options. */
+ char *widgRec; /* Record whose fields contain current
+ * values for options. */
+ Display *display; /* X display; needed for freeing some
+ * resources. */
+ int needFlags; /* Used to specify additional flags
+ * that must be present in config specs
+ * for them to be considered. */
+{
+ register Tk_ConfigSpec *specPtr;
+ char *ptr;
+
+ for (specPtr = specs; specPtr->type != TK_CONFIG_END; specPtr++) {
+ if ((specPtr->specFlags & needFlags) != needFlags) {
+ continue;
+ }
+ ptr = widgRec + specPtr->offset;
+ switch (specPtr->type) {
+ case TK_CONFIG_STRING:
+ if (*((char **) ptr) != NULL) {
+ ckfree(*((char **) ptr));
+ *((char **) ptr) = NULL;
+ }
+ break;
+ case TK_CONFIG_COLOR:
+ if (*((XColor **) ptr) != NULL) {
+ Tk_FreeColor(*((XColor **) ptr));
+ *((XColor **) ptr) = NULL;
+ }
+ break;
+ case TK_CONFIG_FONT:
+ Tk_FreeFont(*((Tk_Font *) ptr));
+ *((Tk_Font *) ptr) = NULL;
+ break;
+ case TK_CONFIG_BITMAP:
+ if (*((Pixmap *) ptr) != None) {
+ Tk_FreeBitmap(display, *((Pixmap *) ptr));
+ *((Pixmap *) ptr) = None;
+ }
+ break;
+ case TK_CONFIG_BORDER:
+ if (*((Tk_3DBorder *) ptr) != NULL) {
+ Tk_Free3DBorder(*((Tk_3DBorder *) ptr));
+ *((Tk_3DBorder *) ptr) = NULL;
+ }
+ break;
+ case TK_CONFIG_CURSOR:
+ case TK_CONFIG_ACTIVE_CURSOR:
+ if (*((Tk_Cursor *) ptr) != None) {
+ Tk_FreeCursor(display, *((Tk_Cursor *) ptr));
+ *((Tk_Cursor *) ptr) = None;
+ }
+ }
+ }
+}
+
+
diff --git a/tk/generic/tkOption.c b/tk/generic/tkOption.c
index f3807167edb..54e1f27d75e 100644
--- a/tk/generic/tkOption.c
+++ b/tk/generic/tkOption.c
@@ -6,7 +6,7 @@
* with windows either by name or by class or both.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -141,13 +141,6 @@ typedef struct ElArray {
*/
#define NUM_STACKS 8
-static ElArray *stacks[NUM_STACKS];
-static TkWindow *cachedWindow = NULL; /* Lowest-level window currently
- * loaded in stacks at present.
- * NULL means stacks have never
- * been used, or have been
- * invalidated because of a change
- * to the database. */
/*
* One of the following structures is used to keep track of each
@@ -163,33 +156,41 @@ typedef struct StackLevel {
* fields when popping out of a level. */
} StackLevel;
-/*
- * Information about all of the stack levels that are currently
- * active. This array grows dynamically to become as large as needed.
- */
+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.
+ */
-static StackLevel *levels = NULL;
- /* Array describing current stack. */
-static int numLevels = 0; /* Total space allocated. */
-static int curLevel = -1; /* Highest level currently in use. Note:
+ 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.
+ */
-/*
- * The variable below is a serial number for all options entered into
- * the database so far. It increments on each addition to the option
- * database. It is used in computing option priorities, so that the
- * most recent entry wins when choosing between options at the same
- * priority level.
- */
-
-static int serial = 0;
-
-/*
- * Special "no match" Element to use as default for searches.
- */
-
-static Element defaultMatch;
+ 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:
@@ -248,11 +249,13 @@ Tk_AddOption(tkwin, name, value, priority)
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);
}
- cachedWindow = NULL; /* Invalidate the cache. */
+ tsdPtr->cachedWindow = NULL; /* Invalidate the cache. */
/*
* Compute the priority for the new element, including both the
@@ -265,8 +268,8 @@ Tk_AddOption(tkwin, name, value, priority)
} else if (priority > TK_MAX_PRIO) {
priority = TK_MAX_PRIO;
}
- newEl.priority = (priority << 24) + serial;
- serial++;
+ newEl.priority = (priority << 24) + tsdPtr->serial;
+ tsdPtr->serial++;
/*
* Parse the option one field at a time.
@@ -396,28 +399,30 @@ Tk_GetOption(tkwin, name, className)
Tk_Uid nameId, classId;
register Element *elPtr, *bestPtr;
register int count;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Note: no need to call OptionInit here: it will be done by
* the SetupStacks call below (squeeze out those nanoseconds).
*/
- if (tkwin != (Tk_Window) cachedWindow) {
+ if (tkwin != (Tk_Window) tsdPtr->cachedWindow) {
SetupStacks((TkWindow *) tkwin, 1);
}
nameId = Tk_GetUid(name);
- bestPtr = &defaultMatch;
- for (elPtr = stacks[EXACT_LEAF_NAME]->els,
- count = stacks[EXACT_LEAF_NAME]->numUsed; count > 0;
+ bestPtr = &tsdPtr->defaultMatch;
+ for (elPtr = tsdPtr->stacks[EXACT_LEAF_NAME]->els,
+ count = tsdPtr->stacks[EXACT_LEAF_NAME]->numUsed; count > 0;
elPtr++, count--) {
if ((elPtr->nameUid == nameId)
&& (elPtr->priority > bestPtr->priority)) {
bestPtr = elPtr;
}
}
- for (elPtr = stacks[WILDCARD_LEAF_NAME]->els,
- count = stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0;
+ for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_NAME]->els,
+ count = tsdPtr->stacks[WILDCARD_LEAF_NAME]->numUsed; count > 0;
elPtr++, count--) {
if ((elPtr->nameUid == nameId)
&& (elPtr->priority > bestPtr->priority)) {
@@ -426,17 +431,17 @@ Tk_GetOption(tkwin, name, className)
}
if (className != NULL) {
classId = Tk_GetUid(className);
- for (elPtr = stacks[EXACT_LEAF_CLASS]->els,
- count = stacks[EXACT_LEAF_CLASS]->numUsed; count > 0;
+ for (elPtr = tsdPtr->stacks[EXACT_LEAF_CLASS]->els,
+ count = tsdPtr->stacks[EXACT_LEAF_CLASS]->numUsed; count > 0;
elPtr++, count--) {
if ((elPtr->nameUid == classId)
&& (elPtr->priority > bestPtr->priority)) {
bestPtr = elPtr;
}
}
- for (elPtr = stacks[WILDCARD_LEAF_CLASS]->els,
- count = stacks[WILDCARD_LEAF_CLASS]->numUsed; count > 0;
- elPtr++, count--) {
+ for (elPtr = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->els,
+ count = tsdPtr->stacks[WILDCARD_LEAF_CLASS]->numUsed;
+ count > 0; elPtr++, count--) {
if ((elPtr->nameUid == classId)
&& (elPtr->priority > bestPtr->priority)) {
bestPtr = elPtr;
@@ -449,7 +454,7 @@ Tk_GetOption(tkwin, name, className)
/*
*--------------------------------------------------------------
*
- * Tk_OptionCmd --
+ * Tk_OptionObjCmd --
*
* This procedure is invoked to process the "option" Tcl command.
* See the user documentation for details on what it does.
@@ -464,98 +469,117 @@ Tk_GetOption(tkwin, name, className)
*/
int
-Tk_OptionCmd(clientData, interp, argc, argv)
+Tk_OptionObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of Tcl_Obj arguments. */
+ Tcl_Obj *CONST objv[]; /* Tcl_Obj arguments. */
{
Tk_Window tkwin = (Tk_Window) clientData;
- size_t length;
- char c;
+ int index, result;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ static char *optionCmds[] = {
+ "add", "clear", "get", "readfile", NULL
+ };
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " cmd arg ?arg ...?\"", (char *) 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;
}
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)) {
- int priority;
-
- if ((argc != 4) && (argc != 5)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " add pattern value ?priority?\"", (char *) NULL);
- return TCL_ERROR;
- }
- if (argc == 4) {
- priority = TK_INTERACTIVE_PRIO;
- } else {
- priority = ParsePriority(interp, argv[4]);
- if (priority < 0) {
+
+ 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;
}
- Tk_AddOption(tkwin, argv[2], argv[3], priority);
- return TCL_OK;
- } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
- TkMainInfo *mainPtr;
-
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " clear\"", (char *) NULL);
- return TCL_ERROR;
- }
- mainPtr = ((TkWindow *) tkwin)->mainPtr;
- if (mainPtr->optionRootPtr != NULL) {
- ClearOptionTree(mainPtr->optionRootPtr);
- mainPtr->optionRootPtr = NULL;
- }
- cachedWindow = NULL;
- return TCL_OK;
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
- Tk_Window window;
- Tk_Uid value;
-
- if (argc != 5) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " get window name class\"", (char *) NULL);
- return TCL_ERROR;
- }
- window = Tk_NameToWindow(interp, argv[2], tkwin);
- if (window == NULL) {
- return TCL_ERROR;
- }
- value = Tk_GetOption(window, argv[3], argv[4]);
- if (value != NULL) {
- interp->result = value;
+
+ 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;
}
- return TCL_OK;
- } else if ((c == 'r') && (strncmp(argv[1], "readfile", length) == 0)) {
- int priority;
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " readfile fileName ?priority?\"",
- (char *) NULL);
- return TCL_ERROR;
+ 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, value, TCL_STATIC);
+ }
+ break;
}
- if (argc == 4) {
- priority = ParsePriority(interp, argv[3]);
- if (priority < 0) {
+
+ case OPTION_READFILE: {
+ int priority;
+
+ if ((objc != 3) && (objc != 4)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "fileName ?priority?");
return TCL_ERROR;
}
- } else {
- priority = TK_INTERACTIVE_PRIO;
+
+ 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 ReadOptionFile(interp, tkwin, argv[2], priority);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be add, clear, get, or readfile", (char *) NULL);
- return TCL_ERROR;
}
+ return result;
}
/*
@@ -581,6 +605,9 @@ 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.
*/
@@ -588,11 +615,11 @@ TkOptionDeadWindow(winPtr)
if (winPtr->optionLevel != -1) {
int i;
- for (i = 1; i <= curLevel; i++) {
- levels[i].winPtr->optionLevel = -1;
+ for (i = 1; i <= tsdPtr->curLevel; i++) {
+ tsdPtr->levels[i].winPtr->optionLevel = -1;
}
- curLevel = -1;
- cachedWindow = NULL;
+ tsdPtr->curLevel = -1;
+ tsdPtr->cachedWindow = NULL;
}
/*
@@ -632,6 +659,8 @@ TkOptionClassChanged(winPtr)
{
int i, j, *basePtr;
ElArray *arrayPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr->optionLevel == -1) {
return;
@@ -642,22 +671,22 @@ TkOptionClassChanged(winPtr)
* flush all of the levels above the matching one.
*/
- for (i = 1; i <= curLevel; i++) {
- if (levels[i].winPtr == winPtr) {
- for (j = i; j <= curLevel; j++) {
- levels[j].winPtr->optionLevel = -1;
+ 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;
}
- curLevel = i-1;
- basePtr = levels[i].bases;
+ tsdPtr->curLevel = i-1;
+ basePtr = tsdPtr->levels[i].bases;
for (j = 0; j < NUM_STACKS; j++) {
- arrayPtr = stacks[j];
+ arrayPtr = tsdPtr->stacks[j];
arrayPtr->numUsed = basePtr[j];
arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
}
- if (curLevel <= 0) {
- cachedWindow = NULL;
+ if (tsdPtr->curLevel <= 0) {
+ tsdPtr->cachedWindow = NULL;
} else {
- cachedWindow = levels[curLevel].winPtr;
+ tsdPtr->cachedWindow = tsdPtr->levels[tsdPtr->curLevel].winPtr;
}
break;
}
@@ -674,7 +703,7 @@ TkOptionClassChanged(winPtr)
* Results:
* The return value is the integer priority level corresponding
* to string, or -1 if string doesn't point to a valid priority level.
- * In this case, an error message is left in interp->result.
+ * In this case, an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -734,7 +763,7 @@ ParsePriority(interp, string)
* Results:
* The return value is a standard Tcl return code. In the case of
* an error in parsing string, TCL_ERROR will be returned and an
- * error message will be left in interp->result. The memory at
+ * 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.
*
@@ -797,8 +826,10 @@ AddFromString(interp, tkwin, string, priority)
dst = name = src;
while (*src != ':') {
if ((*src == '\0') || (*src == '\n')) {
- sprintf(interp->result, "missing colon on line %d",
- lineNum);
+ 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')) {
@@ -830,7 +861,10 @@ AddFromString(interp, tkwin, string, priority)
src++;
}
if (*src == '\0') {
- sprintf(interp->result, "missing value on line %d", lineNum);
+ char buf[32 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "missing value on line %d", lineNum);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
@@ -842,8 +876,10 @@ AddFromString(interp, tkwin, string, priority)
dst = value = src;
while (*src != '\n') {
if (*src == '\0') {
- sprintf(interp->result, "missing newline on line %d",
- lineNum);
+ 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')) {
@@ -879,7 +915,7 @@ AddFromString(interp, tkwin, string, priority)
* Results:
* The return value is a standard Tcl return code. In the case of
* an error in parsing string, TCL_ERROR will be returned and an
- * error message will be left in interp->result.
+ * error message will be left in the interp's result.
*
* Side effects:
* None.
@@ -1062,6 +1098,8 @@ SetupStacks(winPtr, 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
@@ -1086,7 +1124,7 @@ SetupStacks(winPtr, leaf)
if (winPtr->parentPtr != NULL) {
level = winPtr->parentPtr->optionLevel;
- if ((level == -1) || (cachedWindow == NULL)) {
+ if ((level == -1) || (tsdPtr->cachedWindow == NULL)) {
SetupStacks(winPtr->parentPtr, 0);
level = winPtr->parentPtr->optionLevel;
}
@@ -1100,19 +1138,19 @@ SetupStacks(winPtr, leaf)
* mark those windows as no longer having cached information.
*/
- if (curLevel >= level) {
- while (curLevel >= level) {
- levels[curLevel].winPtr->optionLevel = -1;
- curLevel--;
+ if (tsdPtr->curLevel >= level) {
+ while (tsdPtr->curLevel >= level) {
+ tsdPtr->levels[tsdPtr->curLevel].winPtr->optionLevel = -1;
+ tsdPtr->curLevel--;
}
- levelPtr = &levels[level];
+ levelPtr = &tsdPtr->levels[level];
for (i = 0; i < NUM_STACKS; i++) {
- arrayPtr = stacks[i];
+ arrayPtr = tsdPtr->stacks[i];
arrayPtr->numUsed = levelPtr->bases[i];
arrayPtr->nextToUse = &arrayPtr->els[arrayPtr->numUsed];
}
}
- curLevel = winPtr->optionLevel = level;
+ tsdPtr->curLevel = winPtr->optionLevel = level;
/*
* Step 3: if the root database information isn't loaded or
@@ -1120,11 +1158,11 @@ SetupStacks(winPtr, leaf)
* database root (this only happens if winPtr is a main window).
*/
- if ((curLevel == 1)
- && ((cachedWindow == NULL)
- || (cachedWindow->mainPtr != winPtr->mainPtr))) {
+ if ((tsdPtr->curLevel == 1)
+ && ((tsdPtr->cachedWindow == NULL)
+ || (tsdPtr->cachedWindow->mainPtr != winPtr->mainPtr))) {
for (i = 0; i < NUM_STACKS; i++) {
- arrayPtr = stacks[i];
+ arrayPtr = tsdPtr->stacks[i];
arrayPtr->numUsed = 0;
arrayPtr->nextToUse = arrayPtr->els;
}
@@ -1138,33 +1176,41 @@ SetupStacks(winPtr, leaf)
* any more).
*/
- if (curLevel >= numLevels) {
+ if (tsdPtr->curLevel >= tsdPtr->numLevels) {
StackLevel *newLevels;
newLevels = (StackLevel *) ckalloc((unsigned)
- (numLevels*2*sizeof(StackLevel)));
- memcpy((VOID *) newLevels, (VOID *) levels,
- (numLevels*sizeof(StackLevel)));
- ckfree((char *) levels);
- numLevels *= 2;
- levels = newLevels;
+ (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 = &levels[curLevel];
+ levelPtr = &tsdPtr->levels[tsdPtr->curLevel];
levelPtr->winPtr = winPtr;
- arrayPtr = stacks[EXACT_LEAF_NAME];
+ arrayPtr = tsdPtr->stacks[EXACT_LEAF_NAME];
arrayPtr->numUsed = 0;
arrayPtr->nextToUse = arrayPtr->els;
- arrayPtr = stacks[EXACT_LEAF_CLASS];
+ arrayPtr = tsdPtr->stacks[EXACT_LEAF_CLASS];
arrayPtr->numUsed = 0;
arrayPtr->nextToUse = arrayPtr->els;
- levelPtr->bases[EXACT_LEAF_NAME] = stacks[EXACT_LEAF_NAME]->numUsed;
- levelPtr->bases[EXACT_LEAF_CLASS] = stacks[EXACT_LEAF_CLASS]->numUsed;
- levelPtr->bases[EXACT_NODE_NAME] = stacks[EXACT_NODE_NAME]->numUsed;
- levelPtr->bases[EXACT_NODE_CLASS] = stacks[EXACT_NODE_CLASS]->numUsed;
- levelPtr->bases[WILDCARD_LEAF_NAME] = stacks[WILDCARD_LEAF_NAME]->numUsed;
- levelPtr->bases[WILDCARD_LEAF_CLASS] = stacks[WILDCARD_LEAF_CLASS]->numUsed;
- levelPtr->bases[WILDCARD_NODE_NAME] = stacks[WILDCARD_NODE_NAME]->numUsed;
- levelPtr->bases[WILDCARD_NODE_CLASS] = stacks[WILDCARD_NODE_CLASS]->numUsed;
+ levelPtr->bases[EXACT_LEAF_NAME] = tsdPtr->stacks[EXACT_LEAF_NAME]
+ ->numUsed;
+ levelPtr->bases[EXACT_LEAF_CLASS] = tsdPtr->stacks[EXACT_LEAF_CLASS]
+ ->numUsed;
+ levelPtr->bases[EXACT_NODE_NAME] = tsdPtr->stacks[EXACT_NODE_NAME]
+ ->numUsed;
+ levelPtr->bases[EXACT_NODE_CLASS] = tsdPtr->stacks[EXACT_NODE_CLASS]
+ ->numUsed;
+ levelPtr->bases[WILDCARD_LEAF_NAME] = tsdPtr->stacks[WILDCARD_LEAF_NAME]
+ ->numUsed;
+ levelPtr->bases[WILDCARD_LEAF_CLASS] = tsdPtr->stacks[WILDCARD_LEAF_CLASS]
+ ->numUsed;
+ levelPtr->bases[WILDCARD_NODE_NAME] = tsdPtr->stacks[WILDCARD_NODE_NAME]
+ ->numUsed;
+ levelPtr->bases[WILDCARD_NODE_CLASS] = tsdPtr->stacks[WILDCARD_NODE_CLASS]
+ ->numUsed;
/*
@@ -1184,7 +1230,7 @@ SetupStacks(winPtr, leaf)
} else {
id = winPtr->nameUid;
}
- elPtr = stacks[i]->els;
+ elPtr = tsdPtr->stacks[i]->els;
count = levelPtr->bases[i];
/*
@@ -1203,7 +1249,7 @@ SetupStacks(winPtr, leaf)
ExtendStacks(elPtr->child.arrayPtr, leaf);
}
}
- cachedWindow = winPtr;
+ tsdPtr->cachedWindow = winPtr;
}
/*
@@ -1232,13 +1278,16 @@ ExtendStacks(arrayPtr, leaf)
{
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;
}
- stacks[elPtr->flags] = ExtendArray(stacks[elPtr->flags], elPtr);
+ tsdPtr->stacks[elPtr->flags] = ExtendArray(
+ tsdPtr->stacks[elPtr->flags], elPtr);
}
}
@@ -1266,24 +1315,32 @@ OptionInit(mainPtr)
{
int i;
Tcl_Interp *interp;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Element *defaultMatchPtr = &tsdPtr->defaultMatch;
/*
* First, once-only initialization.
*/
-
- if (numLevels == 0) {
-
- numLevels = 5;
- levels = (StackLevel *) ckalloc((unsigned) (5*sizeof(StackLevel)));
+
+ 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++) {
- stacks[i] = NewArray(10);
- levels[0].bases[i] = 0;
+ tsdPtr->stacks[i] = NewArray(10);
+ tsdPtr->levels[0].bases[i] = 0;
}
- defaultMatch.nameUid = NULL;
- defaultMatch.child.valueUid = NULL;
- defaultMatch.priority = -1;
- defaultMatch.flags = 0;
+ defaultMatchPtr->nameUid = NULL;
+ defaultMatchPtr->child.valueUid = NULL;
+ defaultMatchPtr->priority = -1;
+ defaultMatchPtr->flags = 0;
}
/*
diff --git a/tk/generic/tkPack.c b/tk/generic/tkPack.c
index 9e5d2421fdf..d10d86782b9 100644
--- a/tk/generic/tkPack.c
+++ b/tk/generic/tkPack.c
@@ -5,7 +5,7 @@
* geometry manager for Tk.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -24,7 +24,7 @@ typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;
* structure of the following type:
*/
-typedef struct Packer {
+typedef struct /* Green Bay */ 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
@@ -96,19 +96,6 @@ typedef struct Packer {
#define DONT_PROPAGATE 32
/*
- * Hash table used to map from Tk_Window tokens to corresponding
- * Packer structures:
- */
-
-static Tcl_HashTable packerHashTable;
-
-/*
- * Have statics in this module been initialized?
- */
-
-static int initialized = 0;
-
-/*
* The following structure is the official type record for the
* packer:
*/
@@ -281,7 +268,7 @@ Tk_PackCmd(clientData, interp, argc, argv)
} else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
register Packer *slavePtr;
Tk_Window slave;
- char buffer[300];
+ char buffer[64 + TCL_INTEGER_SPACE * 4];
static char *sideNames[] = {"top", "bottom", "left", "right"};
if (argc != 3) {
@@ -342,9 +329,9 @@ Tk_PackCmd(clientData, interp, argc, argv)
masterPtr = GetPacker(master);
if (argc == 3) {
if (masterPtr->flags & DONT_PROPAGATE) {
- interp->result = "0";
+ Tcl_SetResult(interp, "0", TCL_STATIC);
} else {
- interp->result = "1";
+ Tcl_SetResult(interp, "1", TCL_STATIC);
}
return TCL_OK;
}
@@ -957,10 +944,11 @@ GetPacker(tkwin)
register Packer *packPtr;
Tcl_HashEntry *hPtr;
int new;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
- if (!initialized) {
- initialized = 1;
- Tcl_InitHashTable(&packerHashTable, TCL_ONE_WORD_KEYS);
+ if (!dispPtr->packInit) {
+ dispPtr->packInit = 1;
+ Tcl_InitHashTable(&dispPtr->packerHashTable, TCL_ONE_WORD_KEYS);
}
/*
@@ -968,7 +956,8 @@ GetPacker(tkwin)
* then create a new one.
*/
- hPtr = Tcl_CreateHashEntry(&packerHashTable, (char *) tkwin, &new);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->packerHashTable, (char *) tkwin,
+ &new);
if (!new) {
return (Packer *) Tcl_GetHashValue(hPtr);
}
@@ -1324,6 +1313,7 @@ PackStructureProc(clientData, eventPtr)
XEvent *eventPtr; /* Describes what just happened. */
{
register Packer *packPtr = (Packer *) clientData;
+
if (eventPtr->type == ConfigureNotify) {
if ((packPtr->slavePtr != NULL)
&& !(packPtr->flags & REQUESTED_REPACK)) {
@@ -1353,8 +1343,11 @@ PackStructureProc(clientData, eventPtr)
nextPtr = slavePtr->nextPtr;
slavePtr->nextPtr = NULL;
}
- Tcl_DeleteHashEntry(Tcl_FindHashEntry(&packerHashTable,
- (char *) packPtr->tkwin));
+ 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);
}
@@ -1372,16 +1365,15 @@ PackStructureProc(clientData, eventPtr)
Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
}
} else if (eventPtr->type == UnmapNotify) {
- Packer *packPtr2;
+ 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) {
+ packPtr2 = packPtr2->nextPtr) {
Tk_UnmapWindow(packPtr2->tkwin);
}
}
@@ -1398,7 +1390,7 @@ PackStructureProc(clientData, eventPtr)
*
* Results:
* TCL_OK is returned if all went well. Otherwise, TCL_ERROR is
- * returned and interp->result is set to contain an error message.
+ * returned and the interp's result is set to contain an error message.
*
* Side effects:
* Slave windows get taken over by the packer.
@@ -1725,3 +1717,5 @@ ConfigureSlaves(interp, tkwin, argc, argv)
}
return TCL_OK;
}
+
+
diff --git a/tk/generic/tkPatch.h b/tk/generic/tkPatch.h
new file mode 100644
index 00000000000..c36ed20a17a
--- /dev/null
+++ b/tk/generic/tkPatch.h
@@ -0,0 +1,23 @@
+/*
+ * tkPatch.h --
+ *
+ * This file does nothing except define a "patch level" for Tk.
+ * The patch level has the form "X.YpZ" where X.Y is the base
+ * release, and Z is a serial number that is used to sequence
+ * patches for a given release. Thus 4.0p1 is the first patch
+ * to release 4.0, 4.0p2 is the patch that follows 4.0p1, and
+ * so on. The "pZ" is omitted in an original new release, and
+ * it is replaced with "bZ" for beta releases or "aZ" for alpha
+ * releases (e.g. 4.0b1 is the first beta release of Tk 4.0).
+ * The patch level ensures that patches are applied in the
+ * correct order and only to appropriate sources.
+ *
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkPatch.h 1.22 96/10/02 14:36:36
+ */
+
+#define TK_PATCH_LEVEL "4.2"
diff --git a/tk/generic/tkPlace.c b/tk/generic/tkPlace.c
index 2102b506117..d48895b2d41 100644
--- a/tk/generic/tkPlace.c
+++ b/tk/generic/tkPlace.c
@@ -5,7 +5,7 @@
* for Tk based on absolute placement or "rubber-sheet" placement.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -99,15 +99,6 @@ typedef struct Master {
#define PARENT_RECONFIG_PENDING 1
/*
- * The hash tables below both use Tk_Window tokens as keys. They map
- * from Tk_Windows to Slave and Master structures for windows, if they
- * exist.
- */
-
-static int initialized = 0;
-static Tcl_HashTable masterTable;
-static Tcl_HashTable slaveTable;
-/*
* The following structure is the official type record for the
* placer:
*/
@@ -168,16 +159,7 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
Tcl_HashEntry *hPtr;
size_t length;
int c;
-
- /*
- * Initialize, if that hasn't been done yet.
- */
-
- if (!initialized) {
- Tcl_InitHashTable(&masterTable, TCL_ONE_WORD_KEYS);
- Tcl_InitHashTable(&slaveTable, TCL_ONE_WORD_KEYS);
- initialized = 1;
- }
+ TkDisplay *dispPtr;
if (argc < 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -196,6 +178,18 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
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;
+ }
+
slavePtr = FindSlave(tkwin);
return ConfigureSlave(interp, slavePtr, argc-2, argv+2);
}
@@ -209,6 +203,18 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
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 ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
if (argc < 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -225,7 +231,7 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
argv[0], " forget pathName\"", (char *) NULL);
return TCL_ERROR;
}
- hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin);
+ hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
if (hPtr == NULL) {
return TCL_OK;
}
@@ -243,14 +249,14 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
Tk_UnmapWindow(tkwin);
ckfree((char *) slavePtr);
} else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
- char buffer[50];
+ char buffer[32 + TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " info pathName\"", (char *) NULL);
return TCL_ERROR;
}
- hPtr = Tcl_FindHashEntry(&slaveTable, (char *) tkwin);
+ hPtr = Tcl_FindHashEntry(&dispPtr->slaveTable, (char *) tkwin);
if (hPtr == NULL) {
return TCL_OK;
}
@@ -306,7 +312,7 @@ Tk_PlaceCmd(clientData, interp, argc, argv)
argv[0], " slaves pathName\"", (char *) NULL);
return TCL_ERROR;
}
- hPtr = Tcl_FindHashEntry(&masterTable, (char *) tkwin);
+ hPtr = Tcl_FindHashEntry(&dispPtr->masterTable, (char *) tkwin);
if (hPtr != NULL) {
Master *masterPtr;
masterPtr = (Master *) Tcl_GetHashValue(hPtr);
@@ -348,8 +354,9 @@ FindSlave(tkwin)
Tcl_HashEntry *hPtr;
register Slave *slavePtr;
int new;
+ TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;
- hPtr = Tcl_CreateHashEntry(&slaveTable, (char *) tkwin, &new);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->slaveTable, (char *) tkwin, &new);
if (new) {
slavePtr = (Slave *) ckalloc(sizeof(Slave));
slavePtr->tkwin = tkwin;
@@ -441,8 +448,9 @@ FindMaster(tkwin)
Tcl_HashEntry *hPtr;
register Master *masterPtr;
int new;
+ TkDisplay * dispPtr = ((TkWindow *) tkwin)->dispPtr;
- hPtr = Tcl_CreateHashEntry(&masterTable, (char *) tkwin, &new);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->masterTable, (char *) tkwin, &new);
if (new) {
masterPtr = (Master *) ckalloc(sizeof(Master));
masterPtr->tkwin = tkwin;
@@ -467,7 +475,7 @@ FindMaster(tkwin)
*
* Results:
* A standard Tcl result. If an error occurs then a message is
- * left in interp->result.
+ * left in the interp's result.
*
* Side effects:
* Information in slavePtr may change, and slavePtr's master is
@@ -843,7 +851,7 @@ RecomputePlacement(clientData)
/*
* Step 5: reconfigure the window and map it if needed. If the
* slave is a child of the master, we do this ourselves. If the
- * slave isn't a child of the master, let Tk_MaintainWindow do
+ * 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).
*/
@@ -902,6 +910,7 @@ MasterStructureProc(clientData, eventPtr)
{
register Master *masterPtr = (Master *) clientData;
register Slave *slavePtr, *nextPtr;
+ TkDisplay *dispPtr = ((TkWindow *) masterPtr->tkwin)->dispPtr;
if (eventPtr->type == ConfigureNotify) {
if ((masterPtr->slavePtr != NULL)
@@ -916,7 +925,7 @@ MasterStructureProc(clientData, eventPtr)
nextPtr = slavePtr->nextPtr;
slavePtr->nextPtr = NULL;
}
- Tcl_DeleteHashEntry(Tcl_FindHashEntry(&masterTable,
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->masterTable,
(char *) masterPtr->tkwin));
if (masterPtr->flags & PARENT_RECONFIG_PENDING) {
Tcl_CancelIdleCall(RecomputePlacement, (ClientData) masterPtr);
@@ -971,10 +980,11 @@ SlaveStructureProc(clientData, 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(&slaveTable,
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
(char *) slavePtr->tkwin));
ckfree((char *) slavePtr);
}
@@ -1047,14 +1057,18 @@ PlaceLostSlaveProc(clientData, tkwin)
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(&slaveTable, (char *) tkwin));
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->slaveTable,
+ (char *) tkwin));
Tk_DeleteEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
(ClientData) slavePtr);
ckfree((char *) slavePtr);
}
+
+
diff --git a/tk/generic/tkPlatDecls.h b/tk/generic/tkPlatDecls.h
new file mode 100644
index 00000000000..f2c31235b2a
--- /dev/null
+++ b/tk/generic/tkPlatDecls.h
@@ -0,0 +1,208 @@
+/*
+ * 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 */
+
+typedef struct TkPlatStubs {
+ int magic;
+ struct TkPlatStubHooks *hooks;
+
+#ifdef __WIN32__
+ Window (*tk_AttachHWND) _ANSI_ARGS_((Tk_Window tkwin, HWND hwnd)); /* 0 */
+ HINSTANCE (*tk_GetHINSTANCE) _ANSI_ARGS_((void)); /* 1 */
+ HWND (*tk_GetHWND) _ANSI_ARGS_((Window window)); /* 2 */
+ Tk_Window (*tk_HWNDToWindow) _ANSI_ARGS_((HWND hwnd)); /* 3 */
+ void (*tk_PointerEvent) _ANSI_ARGS_((HWND hwnd, int x, int y)); /* 4 */
+ int (*tk_TranslateWinEvent) _ANSI_ARGS_((HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, LRESULT * result)); /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ void (*tk_MacSetEmbedHandler) _ANSI_ARGS_((Tk_MacEmbedRegisterWinProc * registerWinProcPtr, Tk_MacEmbedGetGrafPortProc * getPortProcPtr, Tk_MacEmbedMakeContainerExistProc * containerExistProcPtr, Tk_MacEmbedGetClipProc * getClipProc, Tk_MacEmbedGetOffsetInParentProc * getOffsetProc)); /* 0 */
+ void (*tk_MacTurnOffMenus) _ANSI_ARGS_((void)); /* 1 */
+ void (*tk_MacTkOwnsCursor) _ANSI_ARGS_((int tkOwnsIt)); /* 2 */
+ void (*tkMacInitMenus) _ANSI_ARGS_((Tcl_Interp * interp)); /* 3 */
+ void (*tkMacInitAppleEvents) _ANSI_ARGS_((Tcl_Interp * interp)); /* 4 */
+ int (*tkMacConvertEvent) _ANSI_ARGS_((EventRecord * eventPtr)); /* 5 */
+ int (*tkMacConvertTkEvent) _ANSI_ARGS_((EventRecord * eventPtr, Window window)); /* 6 */
+ void (*tkGenWMConfigureEvent) _ANSI_ARGS_((Tk_Window tkwin, int x, int y, int width, int height, int flags)); /* 7 */
+ void (*tkMacInvalClipRgns) _ANSI_ARGS_((TkWindow * winPtr)); /* 8 */
+ int (*tkMacHaveAppearance) _ANSI_ARGS_((void)); /* 9 */
+ GWorldPtr (*tkMacGetDrawablePort) _ANSI_ARGS_((Drawable drawable)); /* 10 */
+#endif /* MAC_TCL */
+} TkPlatStubs;
+
+#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 */
+
+#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/tk/generic/tkPointer.c b/tk/generic/tkPointer.c
index 85a6af87811..f51e82b7506 100644
--- a/tk/generic/tkPointer.c
+++ b/tk/generic/tkPointer.c
@@ -16,6 +16,10 @@
#include "tkInt.h"
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
#ifdef MAC_TCL
#define Cursor XCursor
#endif
@@ -32,19 +36,18 @@ static unsigned int buttonMasks[] = {
};
#define ButtonMask(b) (buttonMasks[(b)-Button1])
-/*
- * Declarations of static variables used in the pointer module.
- */
-
-static TkWindow *cursorWinPtr = NULL; /* Window that is currently
- * controlling the global cursor. */
-static TkWindow *grabWinPtr = NULL; /* Window that defines the top of the
+typedef struct ThreadSpecificData {
+ TkWindow *grabWinPtr; /* Window that defines the top of the
* grab tree in a global grab. */
-static XPoint lastPos = { 0, 0}; /* Last reported mouse position. */
-static int lastState = 0; /* Last known state flags. */
-static TkWindow *lastWinPtr = NULL; /* Last reported mouse window. */
-static TkWindow *restrictWinPtr = NULL; /* Window to which all mouse events
+ 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.
@@ -137,8 +140,12 @@ GenerateEnterLeave(winPtr, x, y, state)
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 != lastWinPtr) {
+ if (winPtr != tsdPtr->lastWinPtr) {
if (restrictWinPtr) {
int newPos, oldPos;
@@ -196,7 +203,7 @@ GenerateEnterLeave(winPtr, x, y, state)
crossed = 1;
}
}
- lastWinPtr = winPtr;
+ tsdPtr->lastWinPtr = winPtr;
}
return crossed;
@@ -226,11 +233,13 @@ Tk_UpdatePointer(tkwin, x, y, state)
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 ^ lastState) & ALL_BUTTONS;
+ int changes = (state ^ tsdPtr->lastState) & ALL_BUTTONS;
int type, b, mask;
pos.x = x;
@@ -241,7 +250,8 @@ Tk_UpdatePointer(tkwin, x, y, state)
* state since we haven't generated the button events yet.
*/
- lastState = (state & ~ALL_BUTTONS) | (lastState & ALL_BUTTONS);
+ tsdPtr->lastState = (state & ~ALL_BUTTONS) | (tsdPtr->lastState
+ & ALL_BUTTONS);
/*
* Generate Enter/Leave events. If the pointer has crossed window
@@ -249,8 +259,8 @@ Tk_UpdatePointer(tkwin, x, y, state)
* redundant motion events.
*/
- if (GenerateEnterLeave(winPtr, x, y, lastState)) {
- lastPos = pos;
+ if (GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState)) {
+ tsdPtr->lastPos = pos;
}
/*
@@ -269,30 +279,30 @@ Tk_UpdatePointer(tkwin, x, y, state)
* if this is the first button down.
*/
- if (!restrictWinPtr) {
- if (!grabWinPtr) {
+ if (!tsdPtr->restrictWinPtr) {
+ if (!tsdPtr->grabWinPtr) {
/*
* Mouse is not grabbed, so set a button grab.
*/
- restrictWinPtr = winPtr;
- TkpSetCapture(restrictWinPtr);
+ tsdPtr->restrictWinPtr = winPtr;
+ TkpSetCapture(tsdPtr->restrictWinPtr);
- } else if ((lastState & ALL_BUTTONS) == 0) {
+ } 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, grabWinPtr)
+ if (TkPositionInTree(winPtr, tsdPtr->grabWinPtr)
== TK_GRAB_IN_TREE) {
- restrictWinPtr = winPtr;
+ tsdPtr->restrictWinPtr = winPtr;
} else {
- restrictWinPtr = grabWinPtr;
+ tsdPtr->restrictWinPtr = tsdPtr->grabWinPtr;
}
- TkpSetCapture(restrictWinPtr);
+ TkpSetCapture(tsdPtr->restrictWinPtr);
}
}
@@ -305,8 +315,8 @@ Tk_UpdatePointer(tkwin, x, y, state)
* aren't in a global grab.
*/
- if ((lastState & ALL_BUTTONS) == mask) {
- if (!grabWinPtr) {
+ if ((tsdPtr->lastState & ALL_BUTTONS) == mask) {
+ if (!tsdPtr->grabWinPtr) {
TkpSetCapture(NULL);
}
}
@@ -317,16 +327,16 @@ Tk_UpdatePointer(tkwin, x, y, state)
* the restrict window to the current mouse position.
*/
- if (restrictWinPtr) {
- InitializeEvent(&event, restrictWinPtr, type, x, y,
- lastState, b);
+ if (tsdPtr->restrictWinPtr) {
+ InitializeEvent(&event, tsdPtr->restrictWinPtr, type, x, y,
+ tsdPtr->lastState, b);
Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
- lastState &= ~mask;
- lastWinPtr = restrictWinPtr;
- restrictWinPtr = NULL;
+ tsdPtr->lastState &= ~mask;
+ tsdPtr->lastWinPtr = tsdPtr->restrictWinPtr;
+ tsdPtr->restrictWinPtr = NULL;
- GenerateEnterLeave(winPtr, x, y, lastState);
- lastPos = pos;
+ GenerateEnterLeave(winPtr, x, y, tsdPtr->lastState);
+ tsdPtr->lastPos = pos;
continue;
}
}
@@ -338,10 +348,10 @@ Tk_UpdatePointer(tkwin, x, y, state)
* managed by Tk should be reported to the grab window.
*/
- if (restrictWinPtr) {
- targetWinPtr = restrictWinPtr;
- } else if (grabWinPtr && !winPtr) {
- targetWinPtr = grabWinPtr;
+ if (tsdPtr->restrictWinPtr) {
+ targetWinPtr = tsdPtr->restrictWinPtr;
+ } else if (tsdPtr->grabWinPtr && !winPtr) {
+ targetWinPtr = tsdPtr->grabWinPtr;
} else {
targetWinPtr = winPtr;
}
@@ -352,7 +362,7 @@ Tk_UpdatePointer(tkwin, x, y, state)
if (winPtr != NULL) {
InitializeEvent(&event, targetWinPtr, type, x, y,
- lastState, b);
+ tsdPtr->lastState, b);
Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
}
@@ -360,9 +370,9 @@ Tk_UpdatePointer(tkwin, x, y, state)
* Update the state for the next iteration.
*/
- lastState = (type == ButtonPress)
- ? (lastState | mask) : (lastState & ~mask);
- lastPos = pos;
+ tsdPtr->lastState = (type == ButtonPress)
+ ? (tsdPtr->lastState | mask) : (tsdPtr->lastState & ~mask);
+ tsdPtr->lastPos = pos;
}
}
@@ -370,11 +380,11 @@ Tk_UpdatePointer(tkwin, x, y, state)
* Make sure the cursor window is up to date.
*/
- if (restrictWinPtr) {
- targetWinPtr = restrictWinPtr;
- } else if (grabWinPtr) {
- targetWinPtr = (TkPositionInTree(winPtr, grabWinPtr)
- == TK_GRAB_IN_TREE) ? winPtr : grabWinPtr;
+ 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;
}
@@ -385,19 +395,19 @@ Tk_UpdatePointer(tkwin, x, y, state)
* generate a motion event.
*/
- if (lastPos.x != pos.x || lastPos.y != pos.y) {
- if (restrictWinPtr) {
- targetWinPtr = restrictWinPtr;
- } else if (grabWinPtr && !winPtr) {
- targetWinPtr = grabWinPtr;
+ 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,
- lastState, NotifyNormal);
+ tsdPtr->lastState, NotifyNormal);
Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
}
- lastPos = pos;
+ tsdPtr->lastPos = pos;
}
}
@@ -433,12 +443,16 @@ XGrabPointer(display, grab_window, owner_events, event_mask, pointer_mode,
Cursor cursor;
Time time;
{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
display->request++;
- grabWinPtr = (TkWindow *) Tk_IdToWindow(display, grab_window);
- restrictWinPtr = NULL;
- TkpSetCapture(grabWinPtr);
- if (TkPositionInTree(lastWinPtr, grabWinPtr) != TK_GRAB_IN_TREE) {
- UpdateCursor(grabWinPtr);
+ 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;
}
@@ -464,11 +478,14 @@ XUngrabPointer(display, time)
Display* display;
Time time;
{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
display->request++;
- grabWinPtr = NULL;
- restrictWinPtr = NULL;
+ tsdPtr->grabWinPtr = NULL;
+ tsdPtr->restrictWinPtr = NULL;
TkpSetCapture(NULL);
- UpdateCursor(lastWinPtr);
+ UpdateCursor(tsdPtr->lastWinPtr);
}
/*
@@ -491,16 +508,19 @@ void
TkPointerDeadWindow(winPtr)
TkWindow *winPtr;
{
- if (winPtr == lastWinPtr) {
- lastWinPtr = NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (winPtr == tsdPtr->lastWinPtr) {
+ tsdPtr->lastWinPtr = NULL;
}
- if (winPtr == grabWinPtr) {
- grabWinPtr = NULL;
+ if (winPtr == tsdPtr->grabWinPtr) {
+ tsdPtr->grabWinPtr = NULL;
}
- if (winPtr == restrictWinPtr) {
- restrictWinPtr = NULL;
+ if (winPtr == tsdPtr->restrictWinPtr) {
+ tsdPtr->restrictWinPtr = NULL;
}
- if (!(restrictWinPtr || grabWinPtr)) {
+ if (!(tsdPtr->restrictWinPtr || tsdPtr->grabWinPtr)) {
TkpSetCapture(NULL);
}
}
@@ -527,6 +547,8 @@ 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
@@ -534,7 +556,7 @@ UpdateCursor(winPtr)
* cursor.
*/
- cursorWinPtr = winPtr;
+ tsdPtr->cursorWinPtr = winPtr;
while (winPtr != NULL) {
if (winPtr->atts.cursor != None) {
cursor = winPtr->atts.cursor;
@@ -573,8 +595,10 @@ XDefineCursor(display, w, cursor)
Cursor cursor;
{
TkWindow *winPtr = (TkWindow *)Tk_IdToWindow(display, w);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (cursorWinPtr == winPtr) {
+ if (tsdPtr->cursorWinPtr == winPtr) {
UpdateCursor(winPtr);
}
display->request++;
@@ -621,3 +645,4 @@ TkGenerateActivateEvents(winPtr, active)
TkQueueEventForAllChildren(winPtr, &event);
}
+
diff --git a/tk/generic/tkPort.h b/tk/generic/tkPort.h
index ab9f28b15f8..aef9026bcc6 100644
--- a/tk/generic/tkPort.h
+++ b/tk/generic/tkPort.h
@@ -34,3 +34,4 @@
#endif
#endif /* _TKPORT */
+
diff --git a/tk/generic/tkRectOval.c b/tk/generic/tkRectOval.c
index daa39dafbdf..0bb54885371 100644
--- a/tk/generic/tkRectOval.c
+++ b/tk/generic/tkRectOval.c
@@ -5,7 +5,7 @@
* widgets.
*
* Copyright (c) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -17,6 +17,7 @@
#include "tk.h"
#include "tkInt.h"
#include "tkPort.h"
+#include "tkCanvas.h"
/*
* The structure below defines the record for each rectangle/oval item.
@@ -25,14 +26,17 @@
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. */
- int width; /* Width of outline. */
- XColor *outlineColor; /* Color for outline. */
+ 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. */
- GC outlineGC; /* Graphics context for outline. */
+ 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;
@@ -40,21 +44,93 @@ typedef struct RectOvalItem {
* Information used for parsing configuration specs:
*/
-static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+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, outlineColor), TK_CONFIG_NULL_OK},
+ "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_PIXELS, "-width", (char *) NULL, (char *) NULL,
- "1", Tk_Offset(RectOvalItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {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}
};
@@ -67,10 +143,10 @@ static void ComputeRectOvalBbox _ANSI_ARGS_((Tk_Canvas canvas,
RectOvalItem *rectOvalPtr));
static int ConfigureRectOval _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv, int flags));
+ Tcl_Obj *CONST argv[], int flags));
static int CreateRectOval _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, struct Tk_Item *itemPtr,
- int argc, char **argv));
+ int argc, Tcl_Obj *CONST argv[]));
static void DeleteRectOval _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, Display *display));
static void DisplayRectOval _ANSI_ARGS_((Tk_Canvas canvas,
@@ -82,7 +158,7 @@ static double OvalToPoint _ANSI_ARGS_((Tk_Canvas canvas,
Tk_Item *itemPtr, double *pointPtr));
static int RectOvalCoords _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
- char **argv));
+ Tcl_Obj *CONST argv[]));
static int RectOvalToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
static int RectToArea _ANSI_ARGS_((Tk_Canvas canvas,
@@ -109,7 +185,7 @@ Tk_ItemType tkRectangleType = {
RectOvalCoords, /* coordProc */
DeleteRectOval, /* deleteProc */
DisplayRectOval, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
RectToPoint, /* pointProc */
RectToArea, /* areaProc */
RectOvalToPostscript, /* postscriptProc */
@@ -120,7 +196,7 @@ Tk_ItemType tkRectangleType = {
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
(Tk_ItemInsertProc *) NULL, /* insertProc */
(Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
Tk_ItemType tkOvalType = {
@@ -132,7 +208,7 @@ Tk_ItemType tkOvalType = {
RectOvalCoords, /* coordProc */
DeleteRectOval, /* deleteProc */
DisplayRectOval, /* displayProc */
- 0, /* alwaysRedraw */
+ TK_CONFIG_OBJS, /* flags */
OvalToPoint, /* pointProc */
OvalToArea, /* areaProc */
RectOvalToPostscript, /* postscriptProc */
@@ -143,7 +219,7 @@ Tk_ItemType tkOvalType = {
(Tk_ItemSelectionProc *) NULL, /* selectionProc */
(Tk_ItemInsertProc *) NULL, /* insertProc */
(Tk_ItemDCharsProc *) NULL, /* dTextProc */
- (Tk_ItemType *) NULL /* nextPtr */
+ (Tk_ItemType *) NULL, /* nextPtr */
};
/*
@@ -157,7 +233,7 @@ Tk_ItemType tkOvalType = {
* Results:
* A standard Tcl return value. If an error occurred in
* creating the item, then an error message is left in
- * interp->result; in this case itemPtr is left uninitialized,
+ * the interp's result; in this case itemPtr is left uninitialized,
* so it can be safely freed by the caller.
*
* Side effects:
@@ -173,11 +249,25 @@ CreateRectOval(interp, canvas, itemPtr, argc, argv)
Tk_Item *itemPtr; /* Record to hold new item; header
* has been initialized by caller. */
int argc; /* Number of arguments in argv. */
- char **argv; /* Arguments describing rectangle. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing rectangle. */
{
RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ int i;
+
+
+ if (argc==1) {
+ i = 1;
+ } else {
+ char *arg = Tcl_GetStringFromObj(argv[1], NULL);
+ if ((argc>1) && (arg[0] == '-')
+ && (arg[1] >= 'a') && (arg[1] <= 'z')) {
+ i = 1;
+ } else {
+ i = 4;
+ }
+ }
- if (argc < 4) {
+ if (argc < i) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
itemPtr->typePtr->name, " x1 y1 x2 y2 ?options?\"",
@@ -190,34 +280,33 @@ CreateRectOval(interp, canvas, itemPtr, argc, argv)
* up after errors during the the remainder of this procedure.
*/
- rectOvalPtr->width = 1;
- rectOvalPtr->outlineColor = NULL;
+ 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->outlineGC = None;
+ rectOvalPtr->activeFillStipple = None;
+ rectOvalPtr->disabledFillStipple = None;
rectOvalPtr->fillGC = None;
/*
* Process the arguments to fill in the item record.
*/
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
- &rectOvalPtr->bbox[0]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
- &rectOvalPtr->bbox[1]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[2],
- &rectOvalPtr->bbox[2]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[3],
- &rectOvalPtr->bbox[3]) != TCL_OK)) {
- return TCL_ERROR;
+ if ((RectOvalCoords(interp, canvas, itemPtr, i, argv) != TCL_OK)) {
+ goto error;
}
-
- if (ConfigureRectOval(interp, canvas, itemPtr, argc-4, argv+4, 0)
- != TCL_OK) {
- DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
- return TCL_ERROR;
+ if (ConfigureRectOval(interp, canvas, itemPtr, argc-i, argv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
}
- return TCL_OK;
+
+ error:
+ DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
}
/*
@@ -230,7 +319,7 @@ CreateRectOval(interp, canvas, itemPtr, argc, argv)
* for details on what it does.
*
* Results:
- * Returns TCL_OK or TCL_ERROR, and sets interp->result.
+ * Returns TCL_OK or TCL_ERROR, and sets the interp's result.
*
* Side effects:
* The coordinates for the given item may be changed.
@@ -246,36 +335,51 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv)
* read or modified. */
int argc; /* Number of coordinates supplied in
* argv. */
- char **argv; /* Array of coordinates: x1, y1,
+ Tcl_Obj *CONST argv[]; /* Array of coordinates: x1, y1,
* x2, y2, ... */
{
RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
- char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE];
- char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE];
if (argc == 0) {
- Tcl_PrintDouble(interp, rectOvalPtr->bbox[0], c0);
- Tcl_PrintDouble(interp, rectOvalPtr->bbox[1], c1);
- Tcl_PrintDouble(interp, rectOvalPtr->bbox[2], c2);
- Tcl_PrintDouble(interp, rectOvalPtr->bbox[3], c3);
- Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3,
- (char *) NULL);
- } else if (argc == 4) {
- if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
- &rectOvalPtr->bbox[0]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ 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 ((argc == 1)||(argc == 4)) {
+ if (argc==1) {
+ if (Tcl_ListObjGetElements(interp, argv[0], &argc,
+ (Tcl_Obj ***) &argv) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (argc != 4) {
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ return TCL_ERROR;
+ }
+ }
+ if ((Tk_CanvasGetCoordFromObj(interp, canvas, argv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[1],
&rectOvalPtr->bbox[1]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[2],
&rectOvalPtr->bbox[2]) != TCL_OK)
- || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ || (Tk_CanvasGetCoordFromObj(interp, canvas, argv[3],
&rectOvalPtr->bbox[3]) != TCL_OK)) {
return TCL_ERROR;
}
ComputeRectOvalBbox(canvas, rectOvalPtr);
} else {
- sprintf(interp->result,
- "wrong # coordinates: expected 0 or 4, got %d",
- argc);
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "wrong # coordinates: expected 0 or 4, got %d", argc);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
@@ -292,7 +396,7 @@ RectOvalCoords(interp, canvas, itemPtr, argc, argv)
*
* Results:
* A standard Tcl result code. If an error occurs, then
- * an error message is left in interp->result.
+ * an error message is left in the interp's result.
*
* Side effects:
* Configuration information, such as colors and stipple
@@ -307,7 +411,7 @@ ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags)
Tk_Canvas canvas; /* Canvas containing itemPtr. */
Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
int argc; /* Number of elements in argv. */
- char **argv; /* Arguments describing things to configure. */
+ Tcl_Obj *CONST argv[]; /* Arguments describing things to configure. */
int flags; /* Flags to pass to Tk_ConfigureWidget. */
{
RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
@@ -315,54 +419,136 @@ ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags)
GC newGC;
unsigned long mask;
Tk_Window tkwin;
+ Tk_TSOffset *tsoffset;
+ XColor *color;
+ Pixmap stipple;
+ Tk_State state;
tkwin = Tk_CanvasTkwin(canvas);
- if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
- (char *) rectOvalPtr, flags) != TCL_OK) {
+
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, (char **) argv,
+ (char *) rectOvalPtr, flags|TK_CONFIG_OBJS) != TCL_OK) {
return TCL_ERROR;
}
+ state = itemPtr->state;
/*
* A few of the options require additional processing, such as
* graphics contexts.
*/
- if (rectOvalPtr->width < 1) {
- rectOvalPtr->width = 1;
- }
- if (rectOvalPtr->outlineColor == NULL) {
- newGC = None;
+ 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 {
- gcValues.foreground = rectOvalPtr->outlineColor->pixel;
+ 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;
- gcValues.line_width = rectOvalPtr->width;
- mask = GCForeground|GCCapStyle|GCLineWidth;
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues,
- rectOvalPtr->outlineColor, NULL);
+ mask |= GCCapStyle;
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (rectOvalPtr->outline.gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outline.gc);
}
- if (rectOvalPtr->outlineGC != None) {
- Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outlineGC);
+ 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;
}
- rectOvalPtr->outlineGC = newGC;
- if (rectOvalPtr->fillColor == NULL) {
+ 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 = rectOvalPtr->fillColor->pixel;
- if (rectOvalPtr->fillStipple != None) {
- gcValues.stipple = rectOvalPtr->fillStipple;
+ gcValues.foreground = color->pixel;
+ if (stipple != None) {
+ gcValues.stipple = stipple;
gcValues.fill_style = FillStippled;
mask = GCForeground|GCStipple|GCFillStyle;
} else {
mask = GCForeground;
}
- newGC = Tk_GetGCColor(tkwin, mask, &gcValues, rectOvalPtr->fillColor,
- NULL);
+ 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;
@@ -394,17 +580,24 @@ DeleteRectOval(canvas, itemPtr, display)
{
RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
- if (rectOvalPtr->outlineColor != NULL) {
- Tk_FreeColor(rectOvalPtr->outlineColor);
- }
+ 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->outlineGC != None) {
- Tk_FreeGC(display, rectOvalPtr->outlineGC);
+ 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);
@@ -438,7 +631,28 @@ ComputeRectOvalBbox(canvas, rectOvalPtr)
* recomputed. */
{
int bloat, tmp;
- double dtmp;
+ 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.
@@ -457,10 +671,19 @@ ComputeRectOvalBbox(canvas, rectOvalPtr)
rectOvalPtr->bbox[0] = tmp;
}
- if (rectOvalPtr->outlineColor == NULL) {
+ 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 = (rectOvalPtr->width+1)/2;
+ bloat = (int) (width+1)/2;
}
/*
@@ -519,6 +742,8 @@ DisplayRectOval(canvas, itemPtr, display, drawable, x, y, width, height)
{
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.
@@ -544,9 +769,48 @@ DisplayRectOval(canvas, itemPtr, display, drawable, x, y, width, height)
* 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 (rectOvalPtr->fillStipple != None) {
- Tk_CanvasSetStippleOrigin(canvas, rectOvalPtr->fillGC);
+ 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,
@@ -556,18 +820,20 @@ DisplayRectOval(canvas, itemPtr, display, drawable, x, y, width, height)
x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1),
0, 360*64);
}
- if (rectOvalPtr->fillStipple != None) {
+ if (fillStipple != None) {
XSetTSOrigin(display, rectOvalPtr->fillGC, 0, 0);
}
}
- if (rectOvalPtr->outlineGC != None) {
+ if (rectOvalPtr->outline.gc != None) {
+ Tk_ChangeOutlineGC(canvas, itemPtr, &(rectOvalPtr->outline));
if (rectOvalPtr->header.typePtr == &tkRectangleType) {
- XDrawRectangle(display, drawable, rectOvalPtr->outlineGC,
+ XDrawRectangle(display, drawable, rectOvalPtr->outline.gc,
x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1));
} else {
- XDrawArc(display, drawable, rectOvalPtr->outlineGC,
+ XDrawArc(display, drawable, rectOvalPtr->outline.gc,
x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), 0, 360*64);
}
+ Tk_ResetOutlineGC(canvas, itemPtr, &(rectOvalPtr->outline));
}
}
@@ -603,6 +869,23 @@ RectToPoint(canvas, itemPtr, pointPtr)
{
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
@@ -613,8 +896,8 @@ RectToPoint(canvas, itemPtr, pointPtr)
y1 = rectPtr->bbox[1];
x2 = rectPtr->bbox[2];
y2 = rectPtr->bbox[3];
- if (rectPtr->outlineGC != None) {
- inc = rectPtr->width/2.0;
+ if (rectPtr->outline.gc != None) {
+ inc = width/2.0;
x1 -= inc;
y1 -= inc;
x2 += inc;
@@ -630,7 +913,7 @@ RectToPoint(canvas, itemPtr, pointPtr)
if ((pointPtr[0] >= x1) && (pointPtr[0] < x2)
&& (pointPtr[1] >= y1) && (pointPtr[1] < y2)) {
- if ((rectPtr->fillGC != None) || (rectPtr->outlineGC == None)) {
+ if ((rectPtr->fillGC != None) || (rectPtr->outline.gc == None)) {
return 0.0;
}
xDiff = pointPtr[0] - x1;
@@ -646,7 +929,7 @@ RectToPoint(canvas, itemPtr, pointPtr)
if (yDiff < xDiff) {
xDiff = yDiff;
}
- xDiff -= rectPtr->width;
+ xDiff -= width;
if (xDiff < 0.0) {
return 0.0;
}
@@ -709,10 +992,26 @@ OvalToPoint(canvas, itemPtr, pointPtr)
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;
+ }
+ }
+
- width = ovalPtr->width;
filled = ovalPtr->fillGC != None;
- if (ovalPtr->outlineGC == None) {
+ if (ovalPtr->outline.gc == None) {
width = 0.0;
filled = 1;
}
@@ -750,9 +1049,26 @@ RectToArea(canvas, itemPtr, areaPtr)
{
RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
double halfWidth;
+ double width;
+ Tk_State state = itemPtr->state;
+
+ if(state == TK_STATE_NULL) {
+ state = ((TkCanvas *)canvas)->canvas_state;
+ }
- halfWidth = rectPtr->width/2.0;
- if (rectPtr->outlineGC == None) {
+ 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;
}
@@ -762,7 +1078,7 @@ RectToArea(canvas, itemPtr, areaPtr)
|| (areaPtr[1] >= (rectPtr->bbox[3] + halfWidth))) {
return -1;
}
- if ((rectPtr->fillGC == None) && (rectPtr->outlineGC != None)
+ 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))
@@ -810,13 +1126,30 @@ OvalToArea(canvas, itemPtr, areaPtr)
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 = ovalPtr->width/2.0;
- if (ovalPtr->outlineGC == None) {
+ halfWidth = width/2.0;
+ if (ovalPtr->outline.gc == None) {
halfWidth = 0.0;
}
oval[0] = ovalPtr->bbox[0] - halfWidth;
@@ -833,9 +1166,9 @@ OvalToArea(canvas, itemPtr, areaPtr)
* unfilled center, in which case we should return "outside".
*/
- if ((result == 0) && (ovalPtr->outlineGC != None)
+ if ((result == 0) && (ovalPtr->outline.gc != None)
&& (ovalPtr->fillGC == None)) {
- double centerX, centerY, width, height;
+ double centerX, centerY, height;
double xDelta1, yDelta1, xDelta2, yDelta2;
centerX = (ovalPtr->bbox[0] + ovalPtr->bbox[2])/2.0;
@@ -944,7 +1277,7 @@ TranslateRectOval(canvas, itemPtr, deltaX, deltaY)
* 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.
+ * 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.
*
@@ -964,9 +1297,13 @@ RectOvalToPostscript(interp, canvas, itemPtr, prepass)
* collect font information; 0 means
* final Postscript is being created. */
{
- char pathCmd[500], string[100];
+ 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]);
@@ -989,23 +1326,51 @@ RectOvalToPostscript(interp, canvas, itemPtr, prepass)
(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 (rectOvalPtr->fillColor != NULL) {
+ if (fillColor != NULL) {
Tcl_AppendResult(interp, pathCmd, (char *) NULL);
- if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->fillColor)
+ if (Tk_CanvasPsColor(interp, canvas, fillColor)
!= TCL_OK) {
return TCL_ERROR;
}
- if (rectOvalPtr->fillStipple != None) {
+ if (fillStipple != None) {
Tcl_AppendResult(interp, "clip ", (char *) NULL);
- if (Tk_CanvasPsStipple(interp, canvas, rectOvalPtr->fillStipple)
+ if (Tk_CanvasPsStipple(interp, canvas, fillStipple)
!= TCL_OK) {
return TCL_ERROR;
}
- if (rectOvalPtr->outlineColor != NULL) {
+ if (color != NULL) {
Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
}
} else {
@@ -1017,16 +1382,15 @@ RectOvalToPostscript(interp, canvas, itemPtr, prepass)
* Now draw the outline, if there is one.
*/
- if (rectOvalPtr->outlineColor != NULL) {
- Tcl_AppendResult(interp, pathCmd, (char *) NULL);
- sprintf(string, "%d setlinewidth", rectOvalPtr->width);
- Tcl_AppendResult(interp, string,
- " 0 setlinejoin 2 setlinecap\n", (char *) NULL);
- if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->outlineColor)
- != TCL_OK) {
+ 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;
}
- Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
}
return TCL_OK;
}
+
+
diff --git a/tk/generic/tkScale.c b/tk/generic/tkScale.c
index ea579f587d3..fb88fc3da7f 100644
--- a/tk/generic/tkScale.c
+++ b/tk/generic/tkScale.c
@@ -12,7 +12,8 @@
* permission.
*
* Copyright (c) 1990-1994 The Regents of the University of California.
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * 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.
@@ -26,96 +27,133 @@
#include "tclMath.h"
#include "tkScale.h"
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_SCALE_ACTIVE_BG_COLOR, Tk_Offset(TkScale, activeBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
- DEF_SCALE_ACTIVE_BG_MONO, Tk_Offset(TkScale, activeBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_SCALE_BG_COLOR, Tk_Offset(TkScale, bgBorder),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- DEF_SCALE_BG_MONO, Tk_Offset(TkScale, bgBorder),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",
- DEF_SCALE_BIG_INCREMENT, Tk_Offset(TkScale, bigIncrement), 0},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- DEF_SCALE_BORDER_WIDTH, Tk_Offset(TkScale, borderWidth), 0},
- {TK_CONFIG_STRING, "-command", "command", "Command",
- DEF_SCALE_COMMAND, Tk_Offset(TkScale, command), TK_CONFIG_NULL_OK},
- {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
- DEF_SCALE_CURSOR, Tk_Offset(TkScale, cursor), TK_CONFIG_NULL_OK},
- {TK_CONFIG_INT, "-digits", "digits", "Digits",
- DEF_SCALE_DIGITS, Tk_Offset(TkScale, digits), 0},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_FONT, "-font", "font", "Font",
- DEF_SCALE_FONT, Tk_Offset(TkScale, tkfont),
- 0},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_SCALE_FG_COLOR, Tk_Offset(TkScale, textColorPtr),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
- DEF_SCALE_FG_MONO, Tk_Offset(TkScale, textColorPtr),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_DOUBLE, "-from", "from", "From",
- DEF_SCALE_FROM, Tk_Offset(TkScale, fromValue), 0},
- {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
- "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG,
- Tk_Offset(TkScale, highlightBgColorPtr), 0},
- {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
- DEF_SCALE_HIGHLIGHT, Tk_Offset(TkScale, highlightColorPtr), 0},
- {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
- "HighlightThickness",
- DEF_SCALE_HIGHLIGHT_WIDTH, Tk_Offset(TkScale, highlightWidth), 0},
- {TK_CONFIG_STRING, "-label", "label", "Label",
- DEF_SCALE_LABEL, Tk_Offset(TkScale, label), TK_CONFIG_NULL_OK},
- {TK_CONFIG_PIXELS, "-length", "length", "Length",
- DEF_SCALE_LENGTH, Tk_Offset(TkScale, length), 0},
- {TK_CONFIG_UID, "-orient", "orient", "Orient",
- DEF_SCALE_ORIENT, Tk_Offset(TkScale, orientUid), 0},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- DEF_SCALE_RELIEF, Tk_Offset(TkScale, relief), 0},
- {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
- DEF_SCALE_REPEAT_DELAY, Tk_Offset(TkScale, repeatDelay), 0},
- {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
- DEF_SCALE_REPEAT_INTERVAL, Tk_Offset(TkScale, repeatInterval), 0},
- {TK_CONFIG_DOUBLE, "-resolution", "resolution", "Resolution",
- DEF_SCALE_RESOLUTION, Tk_Offset(TkScale, resolution), 0},
- {TK_CONFIG_BOOLEAN, "-showvalue", "showValue", "ShowValue",
- DEF_SCALE_SHOW_VALUE, Tk_Offset(TkScale, showValue), 0},
- {TK_CONFIG_PIXELS, "-sliderlength", "sliderLength", "SliderLength",
- DEF_SCALE_SLIDER_LENGTH, Tk_Offset(TkScale, sliderLength), 0},
- {TK_CONFIG_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",
- DEF_SCALE_SLIDER_RELIEF, Tk_Offset(TkScale, sliderRelief),
- TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_UID, "-state", "state", "State",
- DEF_SCALE_STATE, Tk_Offset(TkScale, state), 0},
- {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
- DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocus),
- TK_CONFIG_NULL_OK},
- {TK_CONFIG_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",
- DEF_SCALE_TICK_INTERVAL, Tk_Offset(TkScale, tickInterval), 0},
- {TK_CONFIG_DOUBLE, "-to", "to", "To",
- DEF_SCALE_TO, Tk_Offset(TkScale, toValue), 0},
- {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
- DEF_SCALE_TROUGH_COLOR, Tk_Offset(TkScale, troughColorPtr),
- TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
- DEF_SCALE_TROUGH_MONO, Tk_Offset(TkScale, troughColorPtr),
- TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_STRING, "-variable", "variable", "Variable",
- DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varName), TK_CONFIG_NULL_OK},
- {TK_CONFIG_PIXELS, "-width", "width", "Width",
- DEF_SCALE_WIDTH, Tk_Offset(TkScale, width), 0},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+/*
+ * 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 char *commandNames[] = {
+ "cget", "configure", "coords", "get", "identify", "set", (char *) NULL
+};
+
+enum command {
+ COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET,
+ COMMAND_IDENTIFY, COMMAND_SET
};
/*
@@ -125,8 +163,8 @@ static Tk_ConfigSpec configSpecs[] = {
static void ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));
static void ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));
static int ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,
- TkScale *scalePtr, int argc, char **argv,
- int flags));
+ TkScale *scalePtr, int objc,
+ Tcl_Obj *CONST objv[]));
static void DestroyScale _ANSI_ARGS_((char *memPtr));
static void ScaleCmdDeletedProc _ANSI_ARGS_((
ClientData clientData));
@@ -135,10 +173,12 @@ static void ScaleEventProc _ANSI_ARGS_((ClientData clientData,
static char * ScaleVarProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-static int ScaleWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+static 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
@@ -155,7 +195,7 @@ static TkClassProcs scaleClass = {
/*
*--------------------------------------------------------------
*
- * Tk_ScaleCmd --
+ * Tk_ScaleObjCmd --
*
* This procedure is invoked to process the "scale" Tcl
* command. See the user documentation for details on what
@@ -171,28 +211,48 @@ static TkClassProcs scaleClass = {
*/
int
-Tk_ScaleCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window associated with
- * interpreter. */
+Tk_ScaleObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Either NULL or pointer to option table. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- Tk_Window tkwin = (Tk_Window) clientData;
register TkScale *scalePtr;
- Tk_Window new;
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+
+ optionTable = (Tk_OptionTable) clientData;
+ if (optionTable == NULL) {
+ Tcl_CmdInfo info;
+ char *name;
+
+ /*
+ * We haven't created the option table for this widget class
+ * yet. Do it now and save the table as the clientData for
+ * the command, so we'll have access to it in future
+ * invocations of the command.
+ */
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ optionTable = Tk_CreateOptionTable(interp, optionSpecs);
+ name = Tcl_GetString(objv[0]);
+ Tcl_GetCommandInfo(interp, name, &info);
+ info.objClientData = (ClientData) optionTable;
+ Tcl_SetCommandInfo(interp, name, &info);
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
- new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
- if (new == NULL) {
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetString(objv[1]), (char *) NULL);
+ if (tkwin == NULL) {
return TCL_ERROR;
}
- scalePtr = TkpCreateScale(new);
+
+ Tk_SetClass(tkwin, "Scale");
+ scalePtr = TkpCreateScale(tkwin);
/*
* Initialize fields that won't be initialized by ConfigureScale,
@@ -200,79 +260,80 @@ Tk_ScaleCmd(clientData, interp, argc, argv)
* (e.g. resource pointers).
*/
- scalePtr->tkwin = new;
- scalePtr->display = Tk_Display(new);
- scalePtr->interp = interp;
- scalePtr->widgetCmd = Tcl_CreateCommand(interp,
- Tk_PathName(scalePtr->tkwin), ScaleWidgetCmd,
+ 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->orientUid = NULL;
- scalePtr->vertical = 0;
- scalePtr->width = 0;
- scalePtr->length = 0;
- scalePtr->value = 0;
- scalePtr->varName = NULL;
- scalePtr->fromValue = 0;
- scalePtr->toValue = 0;
- scalePtr->tickInterval = 0;
- scalePtr->resolution = 1;
- scalePtr->bigIncrement = 0.0;
- scalePtr->command = NULL;
- scalePtr->repeatDelay = 0;
- scalePtr->repeatInterval = 0;
- scalePtr->label = NULL;
- scalePtr->labelLength = 0;
- scalePtr->state = tkNormalUid;
- scalePtr->borderWidth = 0;
- scalePtr->bgBorder = NULL;
- scalePtr->activeBorder = NULL;
- scalePtr->sliderRelief = TK_RELIEF_RAISED;
- scalePtr->troughColorPtr = NULL;
- scalePtr->troughGC = None;
- scalePtr->copyGC = None;
- scalePtr->tkfont = NULL;
- scalePtr->textColorPtr = NULL;
- scalePtr->textGC = None;
- scalePtr->relief = TK_RELIEF_FLAT;
- scalePtr->highlightWidth = 0;
- scalePtr->highlightBgColorPtr = NULL;
- scalePtr->highlightColorPtr = NULL;
- scalePtr->inset = 0;
- scalePtr->sliderLength = 0;
- scalePtr->showValue = 0;
- scalePtr->horizLabelY = 0;
- scalePtr->horizValueY = 0;
- scalePtr->horizTroughY = 0;
- scalePtr->horizTickY = 0;
- scalePtr->vertTickRightX = 0;
- scalePtr->vertValueRightX = 0;
- scalePtr->vertTroughX = 0;
- scalePtr->vertLabelX = 0;
- scalePtr->cursor = None;
- scalePtr->takeFocus = NULL;
- scalePtr->flags = NEVER_SET;
-
- Tk_SetClass(scalePtr->tkwin, "Scale");
+ 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;
+
TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);
Tk_CreateEventHandler(scalePtr->tkwin,
ExposureMask|StructureNotifyMask|FocusChangeMask,
ScaleEventProc, (ClientData) scalePtr);
- if (ConfigureScale(interp, scalePtr, argc-2, argv+2, 0) != TCL_OK) {
- goto error;
+
+ 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;
}
- interp->result = Tk_PathName(scalePtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(scalePtr->tkwin), TCL_STATIC);
return TCL_OK;
-
- error:
- Tk_DestroyWindow(scalePtr->tkwin);
- return TCL_ERROR;
}
/*
*--------------------------------------------------------------
*
- * ScaleWidgetCmd --
+ * ScaleWidgetObjCmd --
*
* This procedure is invoked to process the Tcl command
* that corresponds to a widget managed by this module.
@@ -288,131 +349,152 @@ Tk_ScaleCmd(clientData, interp, argc, argv)
*/
static int
-ScaleWidgetCmd(clientData, interp, argc, argv)
+ScaleWidgetObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about scale
* widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
{
- register TkScale *scalePtr = (TkScale *) clientData;
- int result = TCL_OK;
- size_t length;
- int c;
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tcl_Obj *objPtr;
+ int index, result;
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ 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);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
- }
- result = Tk_ConfigureValue(interp, scalePtr->tkwin, configSpecs,
- (char *) scalePtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 3)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
- (char *) scalePtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, scalePtr->tkwin, configSpecs,
- (char *) scalePtr, argv[2], 0);
- } else {
- result = ConfigureScale(interp, scalePtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
- && (length >= 3)) {
- int x, y ;
- double value;
-
- if ((argc != 2) && (argc != 3)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " coords ?value?\"", (char *) NULL);
- goto error;
- }
- if (argc == 3) {
- if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
+
+ switch (index) {
+ case COMMAND_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
goto error;
}
- } else {
- value = scalePtr->value;
- }
- if (scalePtr->vertical) {
- x = scalePtr->vertTroughX + scalePtr->width/2
- + scalePtr->borderWidth;
- y = TkpValueToPixel(scalePtr, value);
- } else {
- x = TkpValueToPixel(scalePtr, value);
- y = scalePtr->horizTroughY + scalePtr->width/2
- + scalePtr->borderWidth;
+ objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,
+ scalePtr->optionTable, objv[2], scalePtr->tkwin);
+ if (objPtr == NULL) {
+ goto error;
+ } else {
+ Tcl_SetObjResult(interp, objPtr);
+ }
+ break;
}
- sprintf(interp->result, "%d %d", x, y);
- } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
- double value;
- int x, y;
-
- if ((argc != 2) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " get ?x y?\"", (char *) NULL);
- goto error;
+ 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;
}
- if (argc == 2) {
- value = scalePtr->value;
- } else {
- if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ 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;
}
- value = TkpPixelToValue(scalePtr, x, y);
- }
- sprintf(interp->result, scalePtr->format, value);
- } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
- int x, y, thing;
-
- if (argc != 4) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " identify x y\"", (char *) NULL);
- goto error;
- }
- if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
- || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
- goto error;
- }
- thing = TkpScaleElement(scalePtr, x,y);
- switch (thing) {
- case TROUGH1: interp->result = "trough1"; break;
- case SLIDER: interp->result = "slider"; break;
- case TROUGH2: interp->result = "trough2"; break;
- }
- } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
- double value;
+ if (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 (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " set value\"", (char *) NULL);
- goto error;
- }
- if (Tcl_GetDouble(interp, argv[2], &value) != TCL_OK) {
- goto error;
- }
- if (scalePtr->state != tkDisabledUid) {
- TkpSetScaleValue(scalePtr, value, 1, 1);
- }
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be cget, configure, coords, get, identify, or set",
- (char *) NULL);
- goto error;
+ 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;
@@ -446,14 +528,21 @@ DestroyScale(memPtr)
{
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->varName != NULL) {
- Tcl_UntraceVar(scalePtr->interp, scalePtr->varName,
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, (ClientData) scalePtr);
}
@@ -466,7 +555,9 @@ DestroyScale(memPtr)
if (scalePtr->textGC != None) {
Tk_FreeGC(scalePtr->display, scalePtr->textGC);
}
- Tk_FreeOptions(configSpecs, (char *) scalePtr, scalePtr->display, 0);
+ Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable,
+ scalePtr->tkwin);
+ scalePtr->tkwin = NULL;
TkpDestroyScale(scalePtr);
}
@@ -481,7 +572,7 @@ DestroyScale(memPtr)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, border width,
@@ -492,118 +583,144 @@ DestroyScale(memPtr)
*/
static int
-ConfigureScale(interp, scalePtr, argc, argv, flags)
+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 argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to Tk_ConfigureWidget. */
+ int objc; /* Number of valid entries in objv. */
+ Tcl_Obj *CONST objv[]; /* Argument values. */
{
- size_t length;
+ 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->varName != NULL) {
- Tcl_UntraceVar(interp, scalePtr->varName,
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, (ClientData) scalePtr);
}
- if (Tk_ConfigureWidget(interp, scalePtr->tkwin, configSpecs,
- argc, argv, (char *) scalePtr, flags) != TCL_OK) {
- return TCL_ERROR;
- }
+ for (error = 0; error <= 1; error++) {
+ if (!error) {
+ /*
+ * First pass: set options to new values.
+ */
- /*
- * If the scale is tied to the value of a variable, then set up
- * a trace on the variable's value and set the scale's value from
- * the value of the variable, if it exists.
- */
+ if (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.
+ */
- if (scalePtr->varName != NULL) {
- char *stringValue, *end;
- double value;
+ 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.
+ */
- stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
- if (stringValue != NULL) {
- value = strtod(stringValue, &end);
- if ((end != stringValue) && (*end == 0)) {
+ 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);
}
}
- Tcl_TraceVar(interp, scalePtr->varName,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- ScaleVarProc, (ClientData) scalePtr);
- }
- /*
- * Several options need special processing, such as parsing the
- * orientation and creating GCs.
- */
+ /*
+ * Several options need special processing, such as parsing the
+ * orientation and creating GCs.
+ */
- length = strlen(scalePtr->orientUid);
- if (strncmp(scalePtr->orientUid, "vertical", length) == 0) {
- scalePtr->vertical = 1;
- } else if (strncmp(scalePtr->orientUid, "horizontal", length) == 0) {
- scalePtr->vertical = 0;
- } else {
- Tcl_AppendResult(interp, "bad orientation \"", scalePtr->orientUid,
- "\": must be vertical or horizontal", (char *) NULL);
- return TCL_ERROR;
- }
+ scalePtr->fromValue = TkRoundToResolution(scalePtr,
+ scalePtr->fromValue);
+ scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
+ scalePtr->tickInterval = TkRoundToResolution(scalePtr,
+ scalePtr->tickInterval);
- 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.
+ */
- /*
- * 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);
- if ((scalePtr->tickInterval < 0)
- ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) {
- scalePtr->tickInterval = -scalePtr->tickInterval;
+ 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 and reflect the value in the associated variable,
- * if any.
+ * the scale. We don't set the var here because we need to make
+ * special checks for possibly changed varNamePtr.
*/
- ComputeFormat(scalePtr);
- TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
-
- if (scalePtr->label != NULL) {
- scalePtr->labelLength = strlen(scalePtr->label);
- } else {
- scalePtr->labelLength = 0;
- }
+ TkScaleSetValue(scalePtr, scalePtr->value, 0, 1);
- if ((scalePtr->state != tkNormalUid)
- && (scalePtr->state != tkDisabledUid)
- && (scalePtr->state != tkActiveUid)) {
- Tcl_AppendResult(interp, "bad state value \"", scalePtr->state,
- "\": must be normal, active, or disabled", (char *) NULL);
- scalePtr->state = tkNormalUid;
- return TCL_ERROR;
- }
+ /*
+ * Reestablish the variable trace, if it is needed.
+ */
- Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);
+ if (scalePtr->varNamePtr != NULL) {
+ Tcl_Obj *valuePtr;
- if (scalePtr->highlightWidth < 0) {
- scalePtr->highlightWidth = 0;
+ /*
+ * 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);
}
- scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
ScaleWorldChanged((ClientData) scalePtr);
- return TCL_OK;
+ if (error) {
+ Tcl_SetObjResult(interp, errorResult);
+ Tcl_DecrRefCount(errorResult);
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
}
/*
@@ -635,8 +752,7 @@ ScaleWorldChanged(instanceData)
scalePtr = (TkScale *) instanceData;
gcValues.foreground = scalePtr->troughColorPtr->pixel;
- gc = Tk_GetGCColor(scalePtr->tkwin, GCForeground, &gcValues,
- scalePtr->troughColorPtr, NULL);
+ gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues);
if (scalePtr->troughGC != None) {
Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
}
@@ -644,8 +760,7 @@ ScaleWorldChanged(instanceData)
gcValues.font = Tk_FontId(scalePtr->tkfont);
gcValues.foreground = scalePtr->textColorPtr->pixel;
- gc = Tk_GetGCColor(scalePtr->tkwin, GCForeground | GCFont, &gcValues,
- scalePtr->textColorPtr, NULL);
+ gc = Tk_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues);
if (scalePtr->textGC != None) {
Tk_FreeGC(scalePtr->display, scalePtr->textGC);
}
@@ -804,24 +919,26 @@ ComputeScaleGeometry(scalePtr)
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.
*/
- Tk_GetFontMetrics(scalePtr->tkfont, &fm);
- if (!scalePtr->vertical) {
+ if (scalePtr->orient == ORIENT_HORIZONTAL) {
y = scalePtr->inset;
extraSpace = 0;
if (scalePtr->labelLength != 0) {
scalePtr->horizLabelY = y + SPACING;
- y += fm.linespace + SPACING;
+ y += scalePtr->fontHeight;
extraSpace = SPACING;
}
if (scalePtr->showValue) {
scalePtr->horizValueY = y + SPACING;
- y += fm.linespace + SPACING;
+ y += scalePtr->fontHeight;
extraSpace = SPACING;
} else {
scalePtr->horizValueY = y;
@@ -831,7 +948,7 @@ ComputeScaleGeometry(scalePtr)
y += scalePtr->width + 2*scalePtr->borderWidth;
if (scalePtr->tickInterval != 0) {
scalePtr->horizTickY = y + SPACING;
- y += fm.linespace + 2*SPACING;
+ y += scalePtr->fontHeight + SPACING;
}
Tk_GeometryRequest(scalePtr->tkwin,
scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset);
@@ -884,8 +1001,8 @@ ComputeScaleGeometry(scalePtr)
} else {
scalePtr->vertLabelX = x + fm.ascent/2;
x = scalePtr->vertLabelX + fm.ascent/2
- + Tk_TextWidth(scalePtr->tkfont, scalePtr->label,
- scalePtr->labelLength);
+ + Tk_TextWidth(scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength);
}
Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,
scalePtr->length + 2*scalePtr->inset);
@@ -920,14 +1037,7 @@ ScaleEventProc(clientData, eventPtr)
if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
} else if (eventPtr->type == DestroyNotify) {
- if (scalePtr->tkwin != NULL) {
- scalePtr->tkwin = NULL;
- Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
- }
- if (scalePtr->flags & REDRAW_ALL) {
- Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr);
- }
- Tcl_EventuallyFree((ClientData) scalePtr, DestroyScale);
+ DestroyScale((char *) clientData);
} else if (eventPtr->type == ConfigureNotify) {
ComputeScaleGeometry(scalePtr);
TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
@@ -980,8 +1090,8 @@ ScaleCmdDeletedProc(clientData)
* destroys the widget.
*/
- if (tkwin != NULL) {
- scalePtr->tkwin = NULL;
+ if (!(scalePtr->flags & SCALE_DELETED)) {
+ scalePtr->flags |= SCALE_DELETED;
Tk_DestroyWindow(tkwin);
}
}
@@ -1015,7 +1125,8 @@ TkEventuallyRedrawScale(scalePtr, what)
|| !Tk_IsMapped(scalePtr->tkwin)) {
return;
}
- if ((scalePtr->flags & REDRAW_ALL) == 0) {
+ if (!(scalePtr->flags & REDRAW_PENDING)) {
+ scalePtr->flags |= REDRAW_PENDING;
Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr);
}
scalePtr->flags |= what;
@@ -1043,20 +1154,21 @@ TkRoundToResolution(scalePtr, value)
TkScale *scalePtr; /* Information about scale widget. */
double value; /* Value to round. */
{
- double rem, new;
+ double rem, new, tick;
if (scalePtr->resolution <= 0) {
return value;
}
- new = scalePtr->resolution * floor(value/scalePtr->resolution);
+ tick = floor(value/scalePtr->resolution);
+ new = scalePtr->resolution * tick;
rem = value - new;
if (rem < 0) {
if (rem <= -scalePtr->resolution/2) {
- new -= scalePtr->resolution;
+ new = (tick - 1.0) * scalePtr->resolution;
}
} else {
if (rem >= scalePtr->resolution/2) {
- new += scalePtr->resolution;
+ new = (tick + 1.0) * scalePtr->resolution;
}
}
return new;
@@ -1091,8 +1203,10 @@ ScaleVarProc(clientData, interp, name1, name2, flags)
int flags; /* Information about what happened. */
{
register TkScale *scalePtr = (TkScale *) clientData;
- char *stringValue, *end, *result;
+ char *resultStr;
double value;
+ Tcl_Obj *valuePtr;
+ int result;
/*
* If the variable is unset, then immediately recreate it unless
@@ -1101,17 +1215,17 @@ ScaleVarProc(clientData, interp, name1, name2, flags)
if (flags & TCL_TRACE_UNSETS) {
if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
- Tcl_TraceVar(interp, scalePtr->varName,
+ Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
ScaleVarProc, clientData);
scalePtr->flags |= NEVER_SET;
- TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
+ TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
}
return (char *) NULL;
}
/*
- * If we came here because we updated the variable (in TkpSetScaleValue),
+ * 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.
*/
@@ -1119,27 +1233,216 @@ ScaleVarProc(clientData, interp, name1, name2, flags)
if (scalePtr->flags & SETTING_VAR) {
return (char *) NULL;
}
- result = NULL;
- stringValue = Tcl_GetVar(interp, scalePtr->varName, TCL_GLOBAL_ONLY);
- if (stringValue != NULL) {
- value = strtod(stringValue, &end);
- if ((end == stringValue) || (*end != 0)) {
- result = "can't assign non-numeric value to scale variable";
- } else {
- scalePtr->value = TkRoundToResolution(scalePtr, value);
- }
+ 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 TkpSetScaleValue. This way, TkpSetScaleValue won't bother
+ * 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.
*/
- TkpSetScaleValue(scalePtr, scalePtr->value, 1, 0);
- TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
+ TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);
}
+ TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
- return result;
+ 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/tk/generic/tkScale.h b/tk/generic/tkScale.h
index ee676f3a903..8168aa7171f 100644
--- a/tk/generic/tkScale.h
+++ b/tk/generic/tkScale.h
@@ -5,6 +5,7 @@
* 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.
@@ -25,6 +26,22 @@
#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:
*/
@@ -39,16 +56,16 @@ typedef struct TkScale {
* freed even after tkwin has gone away. */
Tcl_Interp *interp; /* Interpreter associated with scale. */
Tcl_Command widgetCmd; /* Token for scale's widget command. */
- Tk_Uid orientUid; /* Orientation for window ("vertical" or
- * "horizontal"). */
- int vertical; /* Non-zero means vertical orientation,
- * zero means horizontal. */
+ 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. */
- char *varName; /* Name of variable (malloc'ed) or NULL.
+ Tcl_Obj *varNamePtr; /* Name of variable or NULL.
* If non-NULL, scale's value tracks
* the contents of this variable and
* vice versa. */
@@ -56,8 +73,8 @@ typedef struct TkScale {
* 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 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
@@ -67,20 +84,19 @@ typedef struct TkScale {
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). */
+ * scale value. (0 means we pick a value). */
char *command; /* Command prefix to use when invoking Tcl
* commands because the scale value changed.
- * NULL means don't invoke commands.
- * Malloc'ed. */
+ * 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. Malloc'ed. */
+ * scale; NULL means don't display a label. */
int labelLength; /* Number of non-NULL chars. in label. */
- Tk_Uid state; /* Normal or disabled. Value cannot be
- * changed when scale is disabled. */
+ enum state state; /* Values are active, normal, or disabled.
+ * Value of scale cannot be changed when
+ * disabled. */
/*
* Information used when displaying widget:
@@ -90,7 +106,8 @@ typedef struct TkScale {
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. */
+ 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. */
@@ -102,9 +119,10 @@ typedef struct TkScale {
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. */
+ 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.
@@ -114,7 +132,7 @@ typedef struct TkScale {
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
+ * below or to the left of the slider; zero
* means don't display the value. */
/*
@@ -140,10 +158,11 @@ typedef struct TkScale {
* Miscellaneous information:
*/
+ int fontHeight; /* Height of scale font. */
Tk_Cursor cursor; /* Current cursor for window, or None. */
- char *takeFocus; /* Value of -takefocus option; not used in
+ 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. */
+ * scripts. May be NULL. */
int flags; /* Various flags; see below for
* definitions. */
} TkScale;
@@ -156,6 +175,7 @@ typedef struct TkScale {
* 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
@@ -171,16 +191,19 @@ typedef struct TkScale {
* 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
-#define REDRAW_OTHER 2
-#define REDRAW_ALL 3
-#define ACTIVE 4
-#define INVOKE_COMMAND 0x10
-#define SETTING_VAR 0x20
-#define NEVER_SET 0x40
-#define GOT_FOCUS 0x80
+#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
@@ -207,7 +230,7 @@ typedef struct TkScale {
#define PRINT_CHARS 150
/*
- * Declaration of procedures used in the implementation of the scrollbar
+ * Declaration of procedures used in the implementation of the scale
* widget.
*/
@@ -218,16 +241,18 @@ EXTERN double TkRoundToResolution _ANSI_ARGS_((TkScale *scalePtr,
EXTERN TkScale * TkpCreateScale _ANSI_ARGS_((Tk_Window tkwin));
EXTERN void TkpDestroyScale _ANSI_ARGS_((TkScale *scalePtr));
EXTERN void TkpDisplayScale _ANSI_ARGS_((ClientData clientData));
-EXTERN double TkpPixelToValue _ANSI_ARGS_((TkScale *scalePtr,
- int x, int y));
EXTERN int TkpScaleElement _ANSI_ARGS_((TkScale *scalePtr,
int x, int y));
-EXTERN void TkpSetScaleValue _ANSI_ARGS_((TkScale *scalePtr,
+EXTERN void TkScaleSetValue _ANSI_ARGS_((TkScale *scalePtr,
double value, int setVar, int invokeCommand));
-EXTERN int TkpValueToPixel _ANSI_ARGS_((TkScale *scalePtr,
+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/tk/generic/tkScrollbar.c b/tk/generic/tkScrollbar.c
index b49069a0a8a..d0f07c59000 100644
--- a/tk/generic/tkScrollbar.c
+++ b/tk/generic/tkScrollbar.c
@@ -20,6 +20,16 @@
#include "default.h"
/*
+ * Custom option for handling "-orient"
+ */
+
+static Tk_CustomOption orientOption = {
+ (Tk_OptionParseProc *) TkOrientParseProc,
+ TkOrientPrintProc,
+ (ClientData) NULL
+};
+
+/*
* Information used for argv parsing.
*/
@@ -63,8 +73,9 @@ Tk_ConfigSpec tkpScrollbarConfigSpecs[] = {
DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(TkScrollbar, highlightWidth), 0},
{TK_CONFIG_BOOLEAN, "-jump", "jump", "Jump",
DEF_SCROLLBAR_JUMP, Tk_Offset(TkScrollbar, jump), 0},
- {TK_CONFIG_UID, "-orient", "orient", "Orient",
- DEF_SCROLLBAR_ORIENT, Tk_Offset(TkScrollbar, orientUid), 0},
+ {TK_CONFIG_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",
@@ -156,7 +167,6 @@ Tk_ScrollbarCmd(clientData, interp, argc, argv)
scrollPtr->widgetCmd = Tcl_CreateCommand(interp,
Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetCmd,
(ClientData) scrollPtr, ScrollbarCmdDeletedProc);
- scrollPtr->orientUid = NULL;
scrollPtr->vertical = 0;
scrollPtr->width = 0;
scrollPtr->command = NULL;
@@ -193,7 +203,7 @@ Tk_ScrollbarCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
- interp->result = Tk_PathName(scrollPtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(scrollPtr->tkwin), TCL_STATIC);
return TCL_OK;
}
@@ -240,9 +250,15 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
int oldActiveField;
if (argc == 2) {
switch (scrollPtr->activeField) {
- case TOP_ARROW: interp->result = "arrow1"; break;
- case SLIDER: interp->result = "slider"; break;
- case BOTTOM_ARROW: interp->result = "arrow2"; break;
+ 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;
}
@@ -292,6 +308,7 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
} 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 \"",
@@ -316,10 +333,12 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
} else {
fraction = ((double) pixels / (double) length);
}
- sprintf(interp->result, "%g", fraction);
+ 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 \"",
@@ -349,7 +368,8 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
} else if (fraction > 1.0) {
fraction = 1.0;
}
- sprintf(interp->result, "%g", fraction);
+ 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 \"",
@@ -363,9 +383,12 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
Tcl_PrintDouble(interp, scrollPtr->lastFraction, last);
Tcl_AppendResult(interp, first, " ", last, (char *) NULL);
} else {
- sprintf(interp->result, "%d %d %d %d", scrollPtr->totalUnits,
+ 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;
@@ -381,11 +404,21 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
}
thing = TkpScrollbarPosition(scrollPtr, x,y);
switch (thing) {
- case TOP_ARROW: interp->result = "arrow1"; break;
- case TOP_GAP: interp->result = "trough1"; break;
- case SLIDER: interp->result = "slider"; break;
- case BOTTOM_GAP: interp->result = "trough2"; break;
- case BOTTOM_ARROW: interp->result = "arrow2"; break;
+ 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;
@@ -488,7 +521,7 @@ ScrollbarWidgetCmd(clientData, interp, argc, argv)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, border width,
@@ -509,29 +542,16 @@ ConfigureScrollbar(interp, scrollPtr, argc, argv, flags)
int flags; /* Flags to pass to
* Tk_ConfigureWidget. */
{
- size_t length;
-
if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, tkpScrollbarConfigSpecs,
argc, argv, (char *) scrollPtr, flags) != TCL_OK) {
return TCL_ERROR;
}
/*
- * A few options need special processing, such as parsing the
- * orientation or setting the background from a 3-D border.
+ * A few options need special processing, such as setting the
+ * background from a 3-D border.
*/
- length = strlen(scrollPtr->orientUid);
- if (strncmp(scrollPtr->orientUid, "vertical", length) == 0) {
- scrollPtr->vertical = 1;
- } else if (strncmp(scrollPtr->orientUid, "horizontal", length) == 0) {
- scrollPtr->vertical = 0;
- } else {
- Tcl_AppendResult(interp, "bad orientation \"", scrollPtr->orientUid,
- "\": must be vertical or horizontal", (char *) NULL);
- return TCL_ERROR;
- }
-
if (scrollPtr->command != NULL) {
scrollPtr->commandSize = strlen(scrollPtr->command);
} else {
@@ -689,3 +709,4 @@ TkScrollbarEventuallyRedraw(scrollPtr)
scrollPtr->flags |= REDRAW_PENDING;
}
}
+
diff --git a/tk/generic/tkScrollbar.h b/tk/generic/tkScrollbar.h
index fea8ea6b093..c6580640434 100644
--- a/tk/generic/tkScrollbar.h
+++ b/tk/generic/tkScrollbar.h
@@ -39,8 +39,6 @@ typedef struct TkScrollbar {
* freed even after tkwin has gone away. */
Tcl_Interp *interp; /* Interpreter associated with scrollbar. */
Tcl_Command widgetCmd; /* Token for scrollbar's widget command. */
- Tk_Uid orientUid; /* Orientation for window ("vertical" or
- * "horizontal"). */
int vertical; /* Non-zero means vertical orientation
* requested, zero means horizontal. */
int width; /* Desired narrow dimension of scrollbar,
@@ -206,3 +204,4 @@ EXTERN int TkpScrollbarPosition _ANSI_ARGS_((
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKSCROLLBAR */
+
diff --git a/tk/generic/tkSelect.c b/tk/generic/tkSelect.c
index f97d5e411fe..45821e1e3b4 100644
--- a/tk/generic/tkSelect.c
+++ b/tk/generic/tkSelect.c
@@ -6,7 +6,7 @@
* and Tcl commands.
*
* Copyright (c) 1990-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -26,6 +26,11 @@
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. */
@@ -45,12 +50,16 @@ typedef struct LostCommand {
} LostCommand;
/*
- * Shared variables:
+ * The structure below is used to keep each thread's pending list
+ * separate.
*/
-TkSelInProgress *pendingPtr = NULL;
+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:
@@ -199,6 +208,8 @@ Tk_DeleteSelHandler(tkwin, selection, target)
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
@@ -220,7 +231,8 @@ Tk_DeleteSelHandler(tkwin, selection, target)
* handler is dead.
*/
- for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
if (ipPtr->selPtr == selPtr) {
ipPtr->selPtr = NULL;
}
@@ -236,7 +248,12 @@ Tk_DeleteSelHandler(tkwin, selection, target)
prevPtr->nextPtr = selPtr->nextPtr;
}
if (selPtr->proc == HandleTclCommand) {
- ckfree((char *) selPtr->clientData);
+ /*
+ * Mark the CommandInfo as deleted and free it if we can.
+ */
+
+ ((CommandInfo*)selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, Tcl_Free);
}
ckfree((char *) selPtr);
}
@@ -431,7 +448,7 @@ Tk_ClearSelection(tkwin, selection)
* Results:
* The return value is a standard Tcl return value.
* If an error occurs (such as no selection exists)
- * then an error message is left in interp->result.
+ * then an error message is left in the interp's result.
*
* Side effects:
* The standard X11 protocols are used to retrieve the
@@ -457,7 +474,7 @@ Tk_ClearSelection(tkwin, selection)
* the "portion" arguments in separate calls will contain
* successive parts of the selection. Proc should normally
* return TCL_OK. If it detects an error then it should return
- * TCL_ERROR and leave an error message in interp->result; the
+ * TCL_ERROR and leave an error message in the interp's result; the
* remainder of the selection retrieval will be aborted.
*
*--------------------------------------------------------------
@@ -480,6 +497,8 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
TkWindow *winPtr = (TkWindow *) tkwin;
TkDisplay *dispPtr = winPtr->dispPtr;
TkSelectionInfo *infoPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (dispPtr->multipleAtom == None) {
TkSelInit(tkwin);
@@ -528,13 +547,13 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
offset = 0;
result = TCL_OK;
ip.selPtr = selPtr;
- ip.nextPtr = pendingPtr;
- pendingPtr = &ip;
+ 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)) {
- pendingPtr = ip.nextPtr;
+ tsdPtr->pendingPtr = ip.nextPtr;
goto cantget;
}
if (count > TK_SEL_BYTES_AT_ONCE) {
@@ -548,7 +567,7 @@ Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
}
offset += count;
}
- pendingPtr = ip.nextPtr;
+ tsdPtr->pendingPtr = ip.nextPtr;
}
return result;
}
@@ -602,9 +621,8 @@ Tk_SelectionCmd(clientData, interp, argc, argv)
char **args;
if (argc < 2) {
- sprintf(interp->result,
- "wrong # args: should be \"%.50s option ?arg arg ...?\"",
- argv[0]);
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
return TCL_ERROR;
}
c = argv[1][0];
@@ -785,6 +803,9 @@ Tk_SelectionCmd(clientData, interp, argc, argv)
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, args[1]);
Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
@@ -854,7 +875,7 @@ Tk_SelectionCmd(clientData, interp, argc, argv)
if ((infoPtr != NULL)
&& (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
- interp->result = Tk_PathName(infoPtr->owner);
+ Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC);
}
return TCL_OK;
}
@@ -878,9 +899,8 @@ Tk_SelectionCmd(clientData, interp, argc, argv)
Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
return TCL_OK;
} else {
- sprintf(interp->result,
- "bad option \"%.50s\": must be clear, get, handle, or own",
- argv[1]);
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be clear, get, handle, or own", (char *) NULL);
return TCL_ERROR;
}
}
@@ -888,6 +908,60 @@ Tk_SelectionCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * 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.
@@ -909,6 +983,8 @@ TkSelDeadWindow(winPtr)
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
@@ -919,13 +995,19 @@ TkSelDeadWindow(winPtr)
while (winPtr->selHandlerList != NULL) {
selPtr = winPtr->selHandlerList;
winPtr->selHandlerList = selPtr->nextPtr;
- for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+ ipPtr = ipPtr->nextPtr) {
if (ipPtr->selPtr == selPtr) {
ipPtr->selPtr = NULL;
}
}
if (selPtr->proc == HandleTclCommand) {
- ckfree((char *) selPtr->clientData);
+ /*
+ * Mark the CommandInfo as deleted and free it if we can.
+ */
+
+ ((CommandInfo*)selPtr->clientData)->interp = NULL;
+ Tcl_EventuallyFree(selPtr->clientData, Tcl_Free);
}
ckfree((char *) selPtr);
}
@@ -1120,21 +1202,42 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
int spaceNeeded, length;
#define MAX_STATIC_SIZE 100
char staticSpace[MAX_STATIC_SIZE];
- char *command;
- Tcl_Interp *interp;
+ char *command, *string;
+ Tcl_Interp *interp = cmdInfoPtr->interp;
Tcl_DString oldResult;
+ Tcl_Obj *objPtr;
+ int extraBytes, charOffset, count, numChars;
+ char *p;
/*
- * We must copy the interpreter pointer from CommandInfo because the
- * command could delete the handler, freeing the CommandInfo data before we
- * are done using it. We must also protect the interpreter from being
- * deleted too soo.
+ * We must also protect the interpreter and the command from being
+ * deleted too soon.
*/
- interp = cmdInfoPtr->interp;
+ 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.
*/
@@ -1145,7 +1248,7 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
} else {
command = (char *) ckalloc((unsigned) spaceNeeded);
}
- sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
+ sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes);
/*
* Execute the command. Be sure to restore the state of the
@@ -1155,14 +1258,41 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
Tcl_DStringInit(&oldResult);
Tcl_DStringGetResult(interp, &oldResult);
if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
- length = strlen(interp->result);
- if (length > maxBytes) {
- length = maxBytes;
+ 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;
}
- memcpy((VOID *) buffer, (VOID *) interp->result, (size_t) length);
- buffer[length] = '\0';
+ count += extraBytes;
} else {
- length = -1;
+ count = -1;
}
Tcl_DStringResult(interp, &oldResult);
@@ -1170,8 +1300,10 @@ HandleTclCommand(clientData, offset, buffer, maxBytes)
ckfree(command);
}
+
+ Tcl_Release(clientData);
Tcl_Release((ClientData) interp);
- return length;
+ return count;
}
/*
@@ -1299,11 +1431,10 @@ TkSelDefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
static void
LostSelection(clientData)
- ClientData clientData; /* Pointer to CommandInfo structure. */
+ ClientData clientData; /* Pointer to LostCommand structure. */
{
LostCommand *lostPtr = (LostCommand *) clientData;
- char *oldResultString;
- Tcl_FreeProc *oldFreeProc;
+ Tcl_Obj *objPtr;
Tcl_Interp *interp;
interp = lostPtr->interp;
@@ -1314,22 +1445,16 @@ LostSelection(clientData)
* restore it after executing the command.
*/
- oldFreeProc = interp->freeProc;
- if (oldFreeProc != TCL_STATIC) {
- oldResultString = interp->result;
- } else {
- oldResultString = (char *) ckalloc((unsigned)
- (strlen(interp->result) + 1));
- strcpy(oldResultString, interp->result);
- oldFreeProc = TCL_DYNAMIC;
- }
- interp->freeProc = TCL_STATIC;
+ objPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_ResetResult(interp);
+
if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
Tcl_BackgroundError(interp);
}
- Tcl_FreeResult(interp);
- interp->result = oldResultString;
- interp->freeProc = oldFreeProc;
+
+ Tcl_SetObjResult(interp, objPtr);
+ Tcl_DecrRefCount(objPtr);
Tcl_Release((ClientData) interp);
@@ -1339,3 +1464,4 @@ LostSelection(clientData)
ckfree((char *) lostPtr);
}
+
diff --git a/tk/generic/tkSelect.h b/tk/generic/tkSelect.h
index 6065aa4b07d..7cce9bbc290 100644
--- a/tk/generic/tkSelect.h
+++ b/tk/generic/tkSelect.h
@@ -95,6 +95,10 @@ typedef struct TkSelRetrievalInfo {
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
@@ -146,14 +150,6 @@ typedef struct TkSelInProgress {
} TkSelInProgress;
/*
- * Declarations for variables shared among the selection-related files:
- */
-
-extern TkSelInProgress *pendingPtr;
- /* Topmost search in progress, or
- * NULL if none. */
-
-/*
* Chunk size for retrieving selection. It's defined both in
* words and in bytes; the word size is used to allocate
* buffer space that's guaranteed to be word-aligned and that
@@ -168,6 +164,11 @@ extern TkSelInProgress *pendingPtr;
* 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_((
@@ -182,3 +183,4 @@ extern void TkSelUpdateClipboard _ANSI_ARGS_((TkWindow *winPtr,
#endif
#endif /* _TKSELECT */
+
diff --git a/tk/generic/tkSend.c b/tk/generic/tkSend.c
new file mode 100644
index 00000000000..074ce5a33d7
--- /dev/null
+++ b/tk/generic/tkSend.c
@@ -0,0 +1,1867 @@
+/*
+ * tkSend.c --
+ *
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
+ *
+ * Copyright (c) 1989-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkSend.c 1.64 96/07/20 17:38:32
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following structure is used to keep track of the interpreters
+ * registered by this process.
+ */
+
+typedef struct RegisteredInterp {
+ char *name; /* Interpreter's name (malloc-ed). */
+ Tcl_Interp *interp; /* Interpreter associated with name. NULL
+ * means that the application was unregistered
+ * or deleted while a send was in progress
+ * to it. */
+ TkDisplay *dispPtr; /* Display for the application. Needed
+ * because we may need to unregister the
+ * interpreter after its main window has
+ * been deleted. */
+ struct RegisteredInterp *nextPtr;
+ /* Next in list of names associated
+ * with interps in this process.
+ * NULL means end of list. */
+} RegisteredInterp;
+
+static RegisteredInterp *registry = NULL;
+ /* List of all interpreters
+ * registered by this process. */
+
+/*
+ * A registry of all interpreters for a display is kept in a
+ * property "InterpRegistry" on the root window of the display.
+ * It is organized as a series of zero or more concatenated strings
+ * (in no particular order), each of the form
+ * window space name '\0'
+ * where "window" is the hex id of the comm. window to use to talk
+ * to an interpreter named "name".
+ *
+ * When the registry is being manipulated by an application (e.g. to
+ * add or remove an entry), it is loaded into memory using a structure
+ * of the following type:
+ */
+
+typedef struct NameRegistry {
+ TkDisplay *dispPtr; /* Display from which the registry was
+ * read. */
+ int locked; /* Non-zero means that the display was
+ * locked when the property was read in. */
+ int modified; /* Non-zero means that the property has
+ * been modified, so it needs to be written
+ * out when the NameRegistry is closed. */
+ unsigned long propLength; /* Length of the property, in bytes. */
+ char *property; /* The contents of the property, or NULL
+ * if none. See format description above;
+ * this is *not* terminated by the first
+ * null character. Dynamically allocated. */
+ int allocedByX; /* Non-zero means must free property with
+ * XFree; zero means use ckfree. */
+} NameRegistry;
+
+/*
+ * When a result is being awaited from a sent command, one of
+ * the following structures is present on a list of all outstanding
+ * sent commands. The information in the structure is used to
+ * process the result when it arrives. You're probably wondering
+ * how there could ever be multiple outstanding sent commands.
+ * This could happen if interpreters invoke each other recursively.
+ * It's unlikely, but possible.
+ */
+
+typedef struct PendingCommand {
+ int serial; /* Serial number expected in
+ * result. */
+ TkDisplay *dispPtr; /* Display being used for communication. */
+ char *target; /* Name of interpreter command is
+ * being sent to. */
+ Window commWindow; /* Target's communication window. */
+ Tcl_Interp *interp; /* Interpreter from which the send
+ * was invoked. */
+ int code; /* Tcl return code for command
+ * will be stored here. */
+ char *result; /* String result for command (malloc'ed),
+ * or NULL. */
+ char *errorInfo; /* Information for "errorInfo" variable,
+ * or NULL (malloc'ed). */
+ char *errorCode; /* Information for "errorCode" variable,
+ * or NULL (malloc'ed). */
+ int gotResponse; /* 1 means a response has been received,
+ * 0 means the command is still outstanding. */
+ struct PendingCommand *nextPtr;
+ /* Next in list of all outstanding
+ * commands. NULL means end of
+ * list. */
+} PendingCommand;
+
+static PendingCommand *pendingCommands = NULL;
+ /* List of all commands currently
+ * being waited for. */
+
+/*
+ * The information below is used for communication between processes
+ * during "send" commands. Each process keeps a private window, never
+ * even mapped, with one property, "Comm". When a command is sent to
+ * an interpreter, the command is appended to the comm property of the
+ * communication window associated with the interp's process. Similarly,
+ * when a result is returned from a sent command, it is also appended
+ * to the comm property.
+ *
+ * Each command and each result takes the form of ASCII text. For a
+ * command, the text consists of a zero character followed by several
+ * null-terminated ASCII strings. The first string consists of the
+ * single letter "c". Subsequent strings have the form "option value"
+ * where the following options are supported:
+ *
+ * -r commWindow serial
+ *
+ * This option means that a response should be sent to the window
+ * whose X identifier is "commWindow" (in hex), and the response should
+ * be identified with the serial number given by "serial" (in decimal).
+ * If this option isn't specified then the send is asynchronous and
+ * no response is sent.
+ *
+ * -n name
+ * "Name" gives the name of the application for which the command is
+ * intended. This option must be present.
+ *
+ * -s script
+ *
+ * "Script" is the script to be executed. This option must be present.
+ *
+ * The options may appear in any order. The -n and -s options must be
+ * present, but -r may be omitted for asynchronous RPCs. For compatibility
+ * with future releases that may add new features, there may be additional
+ * options present; as long as they start with a "-" character, they will
+ * be ignored.
+ *
+ * A result also consists of a zero character followed by several null-
+ * terminated ASCII strings. The first string consists of the single
+ * letter "r". Subsequent strings have the form "option value" where
+ * the following options are supported:
+ *
+ * -s serial
+ *
+ * Identifies the command for which this is the result. It is the
+ * same as the "serial" field from the -s option in the command. This
+ * option must be present.
+ *
+ * -c code
+ *
+ * "Code" is the completion code for the script, in decimal. If the
+ * code is omitted it defaults to TCL_OK.
+ *
+ * -r result
+ *
+ * "Result" is the result string for the script, which may be either
+ * a result or an error message. If this field is omitted then it
+ * defaults to an empty string.
+ *
+ * -i errorInfo
+ *
+ * "ErrorInfo" gives a string with which to initialize the errorInfo
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * -e errorCode
+ *
+ * "ErrorCode" gives a string with with to initialize the errorCode
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * Options may appear in any order, and only the -s option must be
+ * present. As with commands, there may be additional options besides
+ * these; unknown options are ignored.
+ */
+
+/*
+ * The following variable is the serial number that was used in the
+ * last "send" command. It is exported only for testing purposes.
+ */
+
+int tkSendSerial = 0;
+
+/*
+ * Maximum size property that can be read at one time by
+ * this module:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+/*
+ * The following variable can be set while debugging to do things like
+ * skip locking the server.
+ */
+
+static int sendDebug = 0;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int AppendErrorProc _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errorPtr));
+static void AppendPropCarefully _ANSI_ARGS_((Display *display,
+ Window window, Atom property, char *value,
+ int length, PendingCommand *pendingPtr));
+static void DeleteProc _ANSI_ARGS_((ClientData clientData));
+static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name, Window commWindow));
+static void RegClose _ANSI_ARGS_((NameRegistry *regPtr));
+static void RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name));
+static Window RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
+ char *name));
+static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
+ TkDisplay *dispPtr, int lock));
+static void SendEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int SendInit _ANSI_ARGS_((Tcl_Interp *interp,
+ TkDisplay *dispPtr));
+static Tk_RestrictAction SendRestrictProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
+static void TimeoutProc _ANSI_ARGS_((ClientData clientData));
+static void UpdateCommWindow _ANSI_ARGS_((TkDisplay *dispPtr));
+static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
+ char *name, Window commWindow, int oldOK));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegOpen --
+ *
+ * This procedure loads the name registry for a display into
+ * memory so that it can be manipulated.
+ *
+ * Results:
+ * The return value is a pointer to the loaded registry.
+ *
+ * Side effects:
+ * If "lock" is set then the server will be locked. It is the
+ * caller's responsibility to call RegClose when finished with
+ * the registry, so that we can write back the registry if
+ * neeeded, unlock the server if needed, and free memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static NameRegistry *
+RegOpen(interp, dispPtr, lock)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting
+ * (errors cause a panic so in fact no
+ * error is ever returned, but the interpreter
+ * is needed anyway). */
+ TkDisplay *dispPtr; /* Display whose name registry is to be
+ * opened. */
+ int lock; /* Non-zero means lock the window server
+ * when opening the registry, so no-one
+ * else can use the registry until we
+ * close it. */
+{
+ NameRegistry *regPtr;
+ int result, actualFormat;
+ unsigned long bytesAfter;
+ Atom actualType;
+
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, dispPtr);
+ }
+
+ regPtr = (NameRegistry *) ckalloc(sizeof(NameRegistry));
+ regPtr->dispPtr = dispPtr;
+ regPtr->locked = 0;
+ regPtr->modified = 0;
+ regPtr->allocedByX = 1;
+
+ if (lock && !sendDebug) {
+ XGrabServer(dispPtr->display);
+ regPtr->locked = 1;
+ }
+
+ /*
+ * Read the registry property.
+ */
+
+ result = XGetWindowProperty(dispPtr->display,
+ RootWindow(dispPtr->display, 0),
+ dispPtr->registryProperty, 0, MAX_PROP_WORDS,
+ False, XA_STRING, &actualType, &actualFormat,
+ &regPtr->propLength, &bytesAfter,
+ (unsigned char **) &regPtr->property);
+
+ if (actualType == None) {
+ regPtr->propLength = 0;
+ regPtr->property = NULL;
+ } else if ((result != Success) || (actualFormat != 8)
+ || (actualType != XA_STRING)) {
+ /*
+ * The property is improperly formed; delete it.
+ */
+
+ if (regPtr->property != NULL) {
+ XFree(regPtr->property);
+ regPtr->propLength = 0;
+ regPtr->property = NULL;
+ }
+ XDeleteProperty(dispPtr->display,
+ RootWindow(dispPtr->display, 0),
+ dispPtr->registryProperty);
+ }
+
+ /*
+ * Xlib placed an extra null byte after the end of the property, just
+ * to make sure that it is always NULL-terminated. Be sure to include
+ * this byte in our count if it's needed to ensure null termination
+ * (note: as of 8/95 I'm no longer sure why this code is needed; seems
+ * like it shouldn't be).
+ */
+
+ if ((regPtr->propLength > 0)
+ && (regPtr->property[regPtr->propLength-1] != 0)) {
+ regPtr->propLength++;
+ }
+ return regPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegFindName --
+ *
+ * Given an open name registry, this procedure finds an entry
+ * with a given name, if there is one, and returns information
+ * about that entry.
+ *
+ * Results:
+ * The return value is the X identifier for the comm window for
+ * the application named "name", or None if there is no such
+ * entry in the registry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Window
+RegFindName(regPtr, name)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ char *name; /* Name of an application. */
+{
+ char *p, *entry;
+ Window commWindow;
+
+ commWindow = None;
+ for (p = regPtr->property; (p-regPtr->property) < regPtr->propLength; ) {
+ entry = p;
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if ((*p != 0) && (strcmp(name, p+1) == 0)) {
+ if (sscanf(entry, "%x", (unsigned int *) &commWindow) == 1) {
+ return commWindow;
+ }
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+ return None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegDeleteName --
+ *
+ * This procedure deletes the entry for a given name from
+ * an open registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there used to be an entry named "name" in the registry,
+ * then it is deleted and the registry is marked as modified
+ * so it will be written back when closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegDeleteName(regPtr, name)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ char *name; /* Name of an application. */
+{
+ char *p, *entry, *entryName;
+ int count;
+
+ for (p = regPtr->property; (p-regPtr->property) < 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) {
+ memmove((VOID *) entry, (VOID *) p, (size_t) count);
+ }
+ regPtr->propLength -= p - entry;
+ regPtr->modified = 1;
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegAddName --
+ *
+ * Add a new entry to an open registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The open registry is expanded; it is marked as modified so that
+ * it will be written back when closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegAddName(regPtr, name, commWindow)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ char *name; /* Name of an application. The caller
+ * must ensure that this name isn't
+ * already registered. */
+ Window commWindow; /* X identifier for comm. window of
+ * application. */
+{
+ char id[30];
+ char *newProp;
+ int idLength, newBytes;
+
+ sprintf(id, "%x ", (unsigned int) commWindow);
+ idLength = strlen(id);
+ newBytes = idLength + strlen(name) + 1;
+ newProp = (char *) ckalloc((unsigned) (regPtr->propLength + newBytes));
+ strcpy(newProp, id);
+ strcpy(newProp+idLength, name);
+ if (regPtr->property != NULL) {
+ memcpy((VOID *) (newProp + newBytes), (VOID *) regPtr->property,
+ regPtr->propLength);
+ if (regPtr->allocedByX) {
+ XFree(regPtr->property);
+ } else {
+ ckfree(regPtr->property);
+ }
+ }
+ regPtr->modified = 1;
+ regPtr->propLength += newBytes;
+ regPtr->property = newProp;
+ regPtr->allocedByX = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegClose --
+ *
+ * This procedure is called to end a series of operations on
+ * a name registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The registry is written back if it has been modified, and the
+ * X server is unlocked if it was locked. Memory for the
+ * registry is freed, so the caller should never use regPtr
+ * again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegClose(regPtr)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+{
+ if (regPtr->modified) {
+ if (!regPtr->locked && !sendDebug) {
+ panic("The name registry was modified without being locked!");
+ }
+ XChangeProperty(regPtr->dispPtr->display,
+ RootWindow(regPtr->dispPtr->display, 0),
+ regPtr->dispPtr->registryProperty, XA_STRING, 8,
+ PropModeReplace, (unsigned char *) regPtr->property,
+ (int) regPtr->propLength);
+ }
+
+ if (regPtr->locked) {
+ XUngrabServer(regPtr->dispPtr->display);
+ }
+ XFlush(regPtr->dispPtr->display);
+
+ if (regPtr->property != NULL) {
+ if (regPtr->allocedByX) {
+ XFree(regPtr->property);
+ } else {
+ ckfree(regPtr->property);
+ }
+ }
+ ckfree((char *) regPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateName --
+ *
+ * This procedure checks to see if an entry in the registry
+ * is still valid.
+ *
+ * Results:
+ * The return value is 1 if the given commWindow exists and its
+ * name is "name". Otherwise 0 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ValidateName(dispPtr, name, commWindow, oldOK)
+ TkDisplay *dispPtr; /* Display for which to perform the
+ * validation. */
+ char *name; /* The name of an application. */
+ Window commWindow; /* X identifier for the application's
+ * comm. window. */
+ int oldOK; /* Non-zero means that we should consider
+ * an application to be valid even if it
+ * looks like an old-style (pre-4.0) one;
+ * 0 means consider these invalid. */
+{
+ int result, actualFormat, argc, i;
+ unsigned long length, bytesAfter;
+ Atom actualType;
+ char *property;
+ Tk_ErrorHandler handler;
+ char **argv;
+
+ property = NULL;
+
+ /*
+ * Ignore X errors when reading the property (e.g., the window
+ * might not exist). If an error occurs, result will be some
+ * value other than Success.
+ */
+
+ handler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ result = XGetWindowProperty(dispPtr->display, commWindow,
+ dispPtr->appNameProperty, 0, MAX_PROP_WORDS,
+ False, XA_STRING, &actualType, &actualFormat,
+ &length, &bytesAfter, (unsigned char **) &property);
+
+ if ((result == Success) && (actualType == None)) {
+ XWindowAttributes atts;
+
+ /*
+ * The comm. window exists but the property we're looking for
+ * doesn't exist. This probably means that the application
+ * comes from an older version of Tk (< 4.0) that didn't set the
+ * property; if this is the case, then assume for compatibility's
+ * sake that everything's OK. However, it's also possible that
+ * some random application has re-used the window id for something
+ * totally unrelated. Check a few characteristics of the window,
+ * such as its dimensions and mapped state, to be sure that it
+ * still "smells" like a commWindow.
+ */
+
+ if (!oldOK
+ || !XGetWindowAttributes(dispPtr->display, commWindow, &atts)
+ || (atts.width != 1) || (atts.height != 1)
+ || (atts.map_state != IsUnmapped)) {
+ result = 0;
+ } else {
+ result = 1;
+ }
+ } else if ((result == Success) && (actualFormat == 8)
+ && (actualType == XA_STRING)) {
+ result = 0;
+ if (Tcl_SplitList((Tcl_Interp *) NULL, property, &argc, &argv)
+ == TCL_OK) {
+ for (i = 0; i < argc; i++) {
+ if (strcmp(argv[i], name) == 0) {
+ result = 1;
+ break;
+ }
+ }
+ ckfree((char *) argv);
+ }
+ } else {
+ result = 0;
+ }
+ Tk_DeleteErrorHandler(handler);
+ if (property != NULL) {
+ XFree(property);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ServerSecure --
+ *
+ * Check whether a server is secure enough for us to trust
+ * Tcl scripts arriving via that server.
+ *
+ * Results:
+ * The return value is 1 if the server is secure, which means
+ * that host-style authentication is turned on but there are
+ * no hosts in the enabled list. This means that some other
+ * form of authorization (presumably more secure, such as xauth)
+ * is in use.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ServerSecure(dispPtr)
+ TkDisplay *dispPtr; /* Display to check. */
+{
+#ifdef TK_NO_SECURITY
+ return 1;
+#else
+ XHostAddress *addrPtr;
+ int numHosts, secure;
+ Bool enabled;
+
+ secure = 0;
+ addrPtr = XListHosts(dispPtr->display, &numHosts, &enabled);
+ if (enabled && (numHosts == 0)) {
+ secure = 1;
+ }
+ if (addrPtr != NULL) {
+ XFree((char *) addrPtr);
+ }
+ return secure;
+#endif /* TK_NO_SECURITY */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetAppName --
+ *
+ * This procedure is called to associate an ASCII name with a Tk
+ * application. If the application has already been named, the
+ * name replaces the old one.
+ *
+ * Results:
+ * The return value is the name actually given to the application.
+ * This will normally be the same as name, but if name was already
+ * in use for an application then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
+ *
+ * Side effects:
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_SetAppName(tkwin, name)
+ Tk_Window tkwin; /* Token for any window in the application
+ * to be named: it is just used to identify
+ * the application and the display. */
+ char *name; /* The name that will be used to
+ * refer to the interpreter in later
+ * "send" commands. Must be globally
+ * unique. */
+{
+ RegisteredInterp *riPtr, *riPtr2;
+ Window w;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr;
+ NameRegistry *regPtr;
+ Tcl_Interp *interp;
+ char *actualName;
+ Tcl_DString dString;
+ int offset, i;
+
+#ifdef __WIN32__
+ return name;
+#endif /* __WIN32__ */
+
+ dispPtr = winPtr->dispPtr;
+ interp = winPtr->mainPtr->interp;
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, winPtr->dispPtr);
+ }
+
+ /*
+ * See if the application is already registered; if so, remove its
+ * current name from the registry.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 1);
+ for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
+ if (riPtr == NULL) {
+ /*
+ * This interpreter isn't currently registered; create
+ * the data structure that will be used to register it locally,
+ * plus add the "send" command to the interpreter.
+ */
+
+ riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+ riPtr->dispPtr = winPtr->dispPtr;
+ riPtr->nextPtr = registry;
+ registry = riPtr;
+ Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
+ DeleteProc);
+ break;
+ }
+ if (riPtr->interp == interp) {
+ /*
+ * The interpreter is currently registered; remove it from
+ * the name registry.
+ */
+
+ RegDeleteName(regPtr, riPtr->name);
+ ckfree(riPtr->name);
+ break;
+ }
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ actualName = name;
+ offset = 0; /* Needed only to avoid "used before
+ * set" compiler warnings. */
+ for (i = 1; ; i++) {
+ if (i > 1) {
+ if (i == 2) {
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset+10);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(actualName + offset, "%d", i);
+ }
+ w = RegFindName(regPtr, actualName);
+ if (w == None) {
+ break;
+ }
+
+ /*
+ * The name appears to be in use already, but double-check to
+ * be sure (perhaps the application died without removing its
+ * name from the registry?).
+ */
+
+ if (w == Tk_WindowId(dispPtr->commTkwin)) {
+ for (riPtr2 = registry; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) {
+ if ((riPtr2->interp != interp) &&
+ (strcmp(riPtr2->name, actualName) == 0)) {
+ goto nextSuffix;
+ }
+ }
+ RegDeleteName(regPtr, actualName);
+ break;
+ } else if (!ValidateName(winPtr->dispPtr, actualName, w, 1)) {
+ RegDeleteName(regPtr, actualName);
+ break;
+ }
+ nextSuffix:
+ continue;
+ }
+
+ /*
+ * We've now got a name to use. Store it in the name registry and
+ * in the local entry for this application, plus put it in a property
+ * on the commWindow.
+ */
+
+ RegAddName(regPtr, actualName, Tk_WindowId(dispPtr->commTkwin));
+ RegClose(regPtr);
+ riPtr->name = (char *) ckalloc((unsigned) (strlen(actualName) + 1));
+ strcpy(riPtr->name, actualName);
+ if (actualName != name) {
+ Tcl_DStringFree(&dString);
+ }
+ UpdateCommWindow(dispPtr);
+
+ return riPtr->name;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SendCmd --
+ *
+ * This procedure is invoked to process the "send" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SendCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about sender (only
+ * dispPtr field is used). */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkWindow *winPtr;
+ Window commWindow;
+ PendingCommand pending;
+ register RegisteredInterp *riPtr;
+ char *destName, buffer[30];
+ int result, c, async, i, firstArg;
+ size_t length;
+ Tk_RestrictProc *prevRestrictProc;
+ ClientData prevArg;
+ TkDisplay *dispPtr;
+ NameRegistry *regPtr;
+ Tcl_DString request;
+ Tcl_Interp *localInterp; /* Used when the interpreter to
+ * send the command to is within
+ * the same process. */
+
+ /*
+ * Process options, if any.
+ */
+
+ async = 0;
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (i = 1; i < (argc-1); ) {
+ if (argv[i][0] != '-') {
+ break;
+ }
+ c = argv[i][1];
+ length = strlen(argv[i]);
+ if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) {
+ async = 1;
+ i++;
+ } else if ((c == 'd') && (strncmp(argv[i], "-displayof",
+ length) == 0)) {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1],
+ (Tk_Window) winPtr);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ i += 2;
+ } else if (strcmp(argv[i], "--") == 0) {
+ i++;
+ break;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[i],
+ "\": must be -async, -displayof, or --", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (argc < (i+2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ?options? interpName arg ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ destName = argv[i];
+ firstArg = i+1;
+
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, winPtr->dispPtr);
+ }
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the X server.
+ * The only tricky thing is passing the result from the target
+ * interpreter to the invoking interpreter. Watch out: they
+ * could be the same!
+ */
+
+ for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
+ if ((riPtr->dispPtr != dispPtr)
+ || (strcmp(riPtr->name, destName) != 0)) {
+ continue;
+ }
+ Tcl_Preserve((ClientData) riPtr);
+ localInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) localInterp);
+ if (firstArg == (argc-1)) {
+ result = Tcl_GlobalEval(localInterp, argv[firstArg]);
+ } else {
+ Tcl_DStringInit(&request);
+ Tcl_DStringAppend(&request, argv[firstArg], -1);
+ for (i = firstArg+1; i < argc; i++) {
+ Tcl_DStringAppend(&request, " ", 1);
+ Tcl_DStringAppend(&request, argv[i], -1);
+ }
+ result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request));
+ Tcl_DStringFree(&request);
+ }
+ if (interp != localInterp) {
+ if (result == TCL_ERROR) {
+
+ /*
+ * An error occurred, so transfer error information from the
+ * destination interpreter back to our interpreter. Must clear
+ * interp's result before calling Tcl_AddErrorInfo, since
+ * Tcl_AddErrorInfo will store the interp's result in errorInfo
+ * before appending riPtr's $errorInfo; we've already got
+ * everything we need in riPtr's $errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
+ "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
+ Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+ Tcl_GetVar2(localInterp, "errorCode", (char *) NULL,
+ TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
+ }
+ if (localInterp->freeProc != TCL_STATIC) {
+ interp->result = localInterp->result;
+ interp->freeProc = localInterp->freeProc;
+ localInterp->freeProc = TCL_STATIC;
+ } else {
+ Tcl_SetResult(interp, localInterp->result, TCL_VOLATILE);
+ }
+ Tcl_ResetResult(localInterp);
+ }
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) localInterp);
+ return result;
+ }
+
+ /*
+ * Bind the interpreter name to a communication window.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 0);
+ commWindow = RegFindName(regPtr, destName);
+ RegClose(regPtr);
+ if (commWindow == None) {
+ Tcl_AppendResult(interp, "no application named \"",
+ destName, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Send the command to the target interpreter by appending it to the
+ * comm window in the communication window.
+ */
+
+ tkSendSerial++;
+ Tcl_DStringInit(&request);
+ Tcl_DStringAppend(&request, "\0c\0-n ", 6);
+ Tcl_DStringAppend(&request, destName, -1);
+ if (!async) {
+ sprintf(buffer, "%x %d",
+ (unsigned int) Tk_WindowId(dispPtr->commTkwin),
+ tkSendSerial);
+ Tcl_DStringAppend(&request, "\0-r ", 4);
+ Tcl_DStringAppend(&request, buffer, -1);
+ }
+ Tcl_DStringAppend(&request, "\0-s ", 4);
+ Tcl_DStringAppend(&request, argv[firstArg], -1);
+ for (i = firstArg+1; i < argc; i++) {
+ Tcl_DStringAppend(&request, " ", 1);
+ Tcl_DStringAppend(&request, argv[i], -1);
+ }
+ (void) AppendPropCarefully(dispPtr->display, commWindow,
+ dispPtr->commProperty, Tcl_DStringValue(&request),
+ Tcl_DStringLength(&request) + 1,
+ (async) ? (PendingCommand *) NULL : &pending);
+ Tcl_DStringFree(&request);
+ if (async) {
+ /*
+ * This is an asynchronous send: return immediately without
+ * waiting for a response.
+ */
+
+ return TCL_OK;
+ }
+
+ /*
+ * Register the fact that we're waiting for a command to complete
+ * (this is needed by SendEventProc and by AppendErrorProc to pass
+ * back the command's results). Set up a timeout handler so that
+ * we can check during long sends to make sure that the destination
+ * application is still alive.
+ */
+
+ pending.serial = tkSendSerial;
+ pending.dispPtr = dispPtr;
+ pending.target = destName;
+ pending.commWindow = commWindow;
+ pending.interp = interp;
+ pending.result = NULL;
+ pending.errorInfo = NULL;
+ pending.errorCode = NULL;
+ pending.gotResponse = 0;
+ pending.nextPtr = pendingCommands;
+ pendingCommands = &pending;
+
+ /*
+ * Enter a loop processing X events until the result comes
+ * in or the target is declared to be dead. While waiting
+ * for a result, look only at send-related events so that
+ * the send is synchronous with respect to other events in
+ * the application.
+ */
+
+ prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
+ (ClientData) NULL, &prevArg);
+ Tcl_CreateModalTimeout(1000, TimeoutProc, (ClientData) &pending);
+ while (!pending.gotResponse) {
+ Tcl_DoOneEvent(TCL_WINDOW_EVENTS);
+ }
+ Tcl_DeleteModalTimeout(TimeoutProc, (ClientData) &pending);
+ (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);
+
+ /*
+ * Unregister the information about the pending command
+ * and return the result.
+ */
+
+ if (pendingCommands == &pending) {
+ pendingCommands = pending.nextPtr;
+ } else {
+ PendingCommand *pcPtr;
+
+ for (pcPtr = pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if (pcPtr->nextPtr == &pending) {
+ pcPtr->nextPtr = pending.nextPtr;
+ break;
+ }
+ }
+ }
+ if (pending.errorInfo != NULL) {
+ /*
+ * Special trick: must clear the interp's result before calling
+ * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
+ * result in errorInfo before appending pending.errorInfo; we've
+ * already got everything we need in pending.errorInfo.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AddErrorInfo(interp, pending.errorInfo);
+ ckfree(pending.errorInfo);
+ }
+ if (pending.errorCode != NULL) {
+ Tcl_SetVar2(interp, "errorCode", (char *) NULL, pending.errorCode,
+ TCL_GLOBAL_ONLY);
+ ckfree(pending.errorCode);
+ }
+ Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
+ return pending.code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetInterpNames --
+ *
+ * This procedure is invoked to fetch a list of all the
+ * interpreter names currently registered for the display
+ * of a particular window.
+ *
+ * Results:
+ * A standard Tcl return value. Interp->result will be set
+ * to hold a list of all the interpreter names defined for
+ * tkwin's display. If an error occurs, then TCL_ERROR
+ * is returned and interp->result will hold an error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetInterpNames(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter for returning a result. */
+ Tk_Window tkwin; /* Window whose display is to be used
+ * for the lookup. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ char *p, *entry, *entryName;
+ NameRegistry *regPtr;
+ Window commWindow;
+ int count;
+
+ /*
+ * 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) < regPtr->propLength; ) {
+ entry = p;
+ if (sscanf(p, "%x",(unsigned int *) &commWindow) != 1) {
+ commWindow = None;
+ }
+ 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) {
+ memmove((VOID *) entry, (VOID *) p, (size_t) count);
+ }
+ regPtr->propLength -= p - entry;
+ regPtr->modified = 1;
+ p = entry;
+ }
+ }
+ RegClose(regPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SendInit --
+ *
+ * This procedure is called to initialize the
+ * communication channels for sending commands and
+ * receiving results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up various data structures and windows.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SendInit(interp, dispPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting
+ * (no errors are ever returned, but the
+ * interpreter is needed anyway). */
+ TkDisplay *dispPtr; /* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ /*
+ * Create the window used for communication, and set up an
+ * event handler for it.
+ */
+
+ dispPtr->commTkwin = Tk_CreateWindow(interp, (Tk_Window) NULL,
+ "_comm", DisplayString(dispPtr->display));
+ if (dispPtr->commTkwin == NULL) {
+ panic("Tk_CreateWindow failed in SendInit!");
+ }
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->commTkwin,
+ CWOverrideRedirect, &atts);
+ Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask,
+ SendEventProc, (ClientData) dispPtr);
+ Tk_MakeWindowExist(dispPtr->commTkwin);
+
+ /*
+ * Get atoms used as property names.
+ */
+
+ dispPtr->commProperty = Tk_InternAtom(dispPtr->commTkwin, "Comm");
+ dispPtr->registryProperty = Tk_InternAtom(dispPtr->commTkwin,
+ "InterpRegistry");
+ dispPtr->appNameProperty = Tk_InternAtom(dispPtr->commTkwin,
+ "TK_APPLICATION");
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SendEventProc --
+ *
+ * This procedure is invoked automatically by the toolkit
+ * event manager when a property changes on the communication
+ * window. This procedure reads the property and handles
+ * command requests and responses.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are command requests in the property, they
+ * are executed. If there are responses in the property,
+ * their information is saved for the (ostensibly waiting)
+ * "send" commands. The property is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SendEventProc(clientData, eventPtr)
+ ClientData clientData; /* Display information. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ char *propInfo;
+ register char *p;
+ int result, actualFormat;
+ unsigned long numItems, bytesAfter;
+ Atom actualType;
+ Tcl_Interp *remoteInterp; /* Interp in which to execute the command. */
+
+ if ((eventPtr->xproperty.atom != dispPtr->commProperty)
+ || (eventPtr->xproperty.state != PropertyNewValue)) {
+ return;
+ }
+
+ /*
+ * Read the comm property and delete it.
+ */
+
+ propInfo = NULL;
+ result = XGetWindowProperty(dispPtr->display,
+ Tk_WindowId(dispPtr->commTkwin),
+ dispPtr->commProperty, 0, MAX_PROP_WORDS, True,
+ XA_STRING, &actualType, &actualFormat,
+ &numItems, &bytesAfter, (unsigned char **) &propInfo);
+
+ /*
+ * If the property doesn't exist or is improperly formed
+ * then ignore it.
+ */
+
+ if ((result != Success) || (actualType != XA_STRING)
+ || (actualFormat != 8)) {
+ if (propInfo != NULL) {
+ XFree(propInfo);
+ }
+ return;
+ }
+
+ /*
+ * Several commands and results could arrive in the property at
+ * one time; each iteration through the outer loop handles a
+ * single command or result.
+ */
+
+ for (p = propInfo; (p-propInfo) < 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) < numItems) && (*p == '-')) {
+ switch (p[1]) {
+ case 'r':
+ commWindow = (Window) strtoul(p+2, &end, 16);
+ if ((end == p+2) || (*end != ' ')) {
+ commWindow = None;
+ } else {
+ p = serial = end+1;
+ }
+ break;
+ case 'n':
+ if (p[2] == ' ') {
+ interpName = p+3;
+ }
+ break;
+ case 's':
+ if (p[2] == ' ') {
+ script = p+3;
+ }
+ break;
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+
+ if ((script == NULL) || (interpName == NULL)) {
+ continue;
+ }
+
+ /*
+ * Initialize the result property, so that we're ready at any
+ * time if we need to return an error.
+ */
+
+ if (commWindow != None) {
+ Tcl_DStringInit(&reply);
+ Tcl_DStringAppend(&reply, "\0r\0-s ", 6);
+ Tcl_DStringAppend(&reply, serial, -1);
+ Tcl_DStringAppend(&reply, "\0-r ", 4);
+ }
+
+ if (!ServerSecure(dispPtr)) {
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply, "X server insecure (must use xauth-style authorization); command ignored", -1);
+ }
+ result = TCL_ERROR;
+ goto returnResult;
+ }
+
+ /*
+ * Locate the application, then execute the script.
+ */
+
+ for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
+ if (riPtr == NULL) {
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply,
+ "receiver never heard of interpreter \"", -1);
+ Tcl_DStringAppend(&reply, interpName, -1);
+ Tcl_DStringAppend(&reply, "\"", 1);
+ }
+ result = TCL_ERROR;
+ goto returnResult;
+ }
+ if (strcmp(riPtr->name, interpName) == 0) {
+ break;
+ }
+ }
+ Tcl_Preserve((ClientData) riPtr);
+
+ /*
+ * We must protect the interpreter because the script may
+ * enter another event loop, which might call Tcl_DeleteInterp.
+ */
+
+ remoteInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) remoteInterp);
+
+ result = Tcl_GlobalEval(remoteInterp, script);
+
+ /*
+ * The call to Tcl_Release may have released the interpreter
+ * which will cause the "send" command for that interpreter
+ * to be deleted. The command deletion callback will set the
+ * riPtr->interp field to NULL, hence the check below for NULL.
+ */
+
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply, remoteInterp->result, -1);
+ if (result == TCL_ERROR) {
+ char *varValue;
+
+ varValue = Tcl_GetVar2(remoteInterp, "errorInfo",
+ (char *) NULL, TCL_GLOBAL_ONLY);
+ if (varValue != NULL) {
+ Tcl_DStringAppend(&reply, "\0-i ", 4);
+ Tcl_DStringAppend(&reply, varValue, -1);
+ }
+ varValue = Tcl_GetVar2(remoteInterp, "errorCode",
+ (char *) NULL, TCL_GLOBAL_ONLY);
+ if (varValue != NULL) {
+ Tcl_DStringAppend(&reply, "\0-e ", 4);
+ Tcl_DStringAppend(&reply, varValue, -1);
+ }
+ }
+ }
+ Tcl_Release((ClientData) remoteInterp);
+ Tcl_Release((ClientData) riPtr);
+
+ /*
+ * Return the result to the sender if a commWindow was
+ * specified (if none was specified then this is an asynchronous
+ * call). Right now reply has everything but the completion
+ * code, but it needs the NULL to terminate the current option.
+ */
+
+ returnResult:
+ if (commWindow != None) {
+ if (result != TCL_OK) {
+ char buffer[20];
+
+ sprintf(buffer, "%d", result);
+ Tcl_DStringAppend(&reply, "\0-c ", 4);
+ Tcl_DStringAppend(&reply, buffer, -1);
+ }
+ (void) AppendPropCarefully(dispPtr->display, commWindow,
+ dispPtr->commProperty, Tcl_DStringValue(&reply),
+ Tcl_DStringLength(&reply) + 1,
+ (PendingCommand *) NULL);
+ XFlush(dispPtr->display);
+ Tcl_DStringFree(&reply);
+ }
+ } else if ((*p == 'r') && (p[1] == 0)) {
+ int serial, code, gotSerial;
+ char *errorInfo, *errorCode, *resultString;
+ PendingCommand *pcPtr;
+
+ /*
+ *----------------------------------------------------------
+ * This is a reply to some command that we sent out. Iterate
+ * over all of its options. Stop when we reach the end of the
+ * property or something that doesn't look like an option.
+ *----------------------------------------------------------
+ */
+
+ p += 2;
+ code = TCL_OK;
+ gotSerial = 0;
+ errorInfo = NULL;
+ errorCode = NULL;
+ resultString = "";
+ while (((p-propInfo) < numItems) && (*p == '-')) {
+ switch (p[1]) {
+ case 'c':
+ if (sscanf(p+2, " %d", &code) != 1) {
+ code = TCL_OK;
+ }
+ break;
+ case 'e':
+ if (p[2] == ' ') {
+ errorCode = p+3;
+ }
+ break;
+ case 'i':
+ if (p[2] == ' ') {
+ errorInfo = p+3;
+ }
+ break;
+ case 'r':
+ if (p[2] == ' ') {
+ resultString = p+3;
+ }
+ break;
+ case 's':
+ if (sscanf(p+2, " %d", &serial) == 1) {
+ gotSerial = 1;
+ }
+ break;
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+
+ if (!gotSerial) {
+ continue;
+ }
+
+ /*
+ * Give the result information to anyone who's
+ * waiting for it.
+ */
+
+ for (pcPtr = pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
+ continue;
+ }
+ pcPtr->code = code;
+ if (resultString != NULL) {
+ pcPtr->result = (char *) ckalloc((unsigned)
+ (strlen(resultString) + 1));
+ strcpy(pcPtr->result, resultString);
+ }
+ if (code == TCL_ERROR) {
+ if (errorInfo != NULL) {
+ pcPtr->errorInfo = (char *) ckalloc((unsigned)
+ (strlen(errorInfo) + 1));
+ strcpy(pcPtr->errorInfo, errorInfo);
+ }
+ if (errorCode != NULL) {
+ pcPtr->errorCode = (char *) ckalloc((unsigned)
+ (strlen(errorCode) + 1));
+ strcpy(pcPtr->errorCode, errorCode);
+ }
+ }
+ pcPtr->gotResponse = 1;
+ break;
+ }
+ } else {
+ /*
+ * Didn't recognize this thing. Just skip through the next
+ * null character and try again.
+ */
+
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+ }
+ XFree(propInfo);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AppendPropCarefully --
+ *
+ * Append a given property to a given window, but set up
+ * an X error handler so that if the append fails this
+ * procedure can return an error code rather than having
+ * Xlib panic.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given property on the given window is appended to.
+ * If this operation fails and if pendingPtr is non-NULL,
+ * then the pending operation is marked as complete with
+ * an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AppendPropCarefully(display, window, property, value, length, pendingPtr)
+ Display *display; /* Display on which to operate. */
+ Window window; /* Window whose property is to
+ * be modified. */
+ Atom property; /* Name of property. */
+ char *value; /* Characters to append to property. */
+ int length; /* Number of bytes to append. */
+ PendingCommand *pendingPtr; /* Pending command to mark complete
+ * if an error occurs during the
+ * property op. NULL means just
+ * ignore the error. */
+{
+ Tk_ErrorHandler handler;
+
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc,
+ (ClientData) pendingPtr);
+ XChangeProperty(display, window, property, XA_STRING, 8,
+ PropModeAppend, (unsigned char *) value, length);
+ Tk_DeleteErrorHandler(handler);
+}
+
+/*
+ * The procedure below is invoked if an error occurs during
+ * the XChangeProperty operation above.
+ */
+
+ /* ARGSUSED */
+static int
+AppendErrorProc(clientData, errorPtr)
+ ClientData clientData; /* Command to mark complete, or NULL. */
+ XErrorEvent *errorPtr; /* Information about error. */
+{
+ PendingCommand *pendingPtr = (PendingCommand *) clientData;
+ register PendingCommand *pcPtr;
+
+ if (pendingPtr == NULL) {
+ return 0;
+ }
+
+ /*
+ * Make sure this command is still pending.
+ */
+
+ for (pcPtr = pendingCommands; pcPtr != NULL;
+ pcPtr = pcPtr->nextPtr) {
+ if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
+ pcPtr->result = (char *) ckalloc((unsigned)
+ (strlen(pcPtr->target) + 50));
+ sprintf(pcPtr->result, "no application named \"%s\"",
+ pcPtr->target);
+ pcPtr->code = TCL_ERROR;
+ pcPtr->gotResponse = 1;
+ break;
+ }
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TimeoutProc --
+ *
+ * This procedure is invoked when an unusually long amout of
+ * time has elapsed during the processing of a sent command.
+ * It checks to make sure that the target application still
+ * exists, and reschedules itself to check again later.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the target application has gone away abort the send
+ * operation with an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TimeoutProc(clientData)
+ ClientData clientData; /* Information about command that
+ * has been sent but not yet
+ * responded to. */
+{
+ PendingCommand *pcPtr = (PendingCommand *) clientData;
+ register PendingCommand *pcPtr2;
+
+ /*
+ * Make sure that the command is still in the pending list
+ * and that it hasn't already completed. Then validate the
+ * existence of the target application.
+ */
+
+ for (pcPtr2 = pendingCommands; pcPtr2 != NULL;
+ pcPtr2 = pcPtr2->nextPtr) {
+ char *msg;
+ if ((pcPtr2 != pcPtr) || (pcPtr2->result != NULL)) {
+ continue;
+ }
+ if (!ValidateName(pcPtr2->dispPtr, pcPtr2->target,
+ pcPtr2->commWindow, 0)) {
+ if (ValidateName(pcPtr2->dispPtr, pcPtr2->target,
+ pcPtr2->commWindow, 1)) {
+ msg =
+ "target application died or uses a Tk version before 4.0";
+ } else {
+ msg = "target application died";
+ }
+ pcPtr2->code = TCL_ERROR;
+ pcPtr2->result = (char *) ckalloc((unsigned) (strlen(msg) + 1));
+ strcpy(pcPtr2->result, msg);
+ pcPtr2->gotResponse = 1;
+ } else {
+ Tcl_DeleteModalTimeout(TimeoutProc, clientData);
+ Tcl_CreateModalTimeout(2000, TimeoutProc, clientData);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteProc --
+ *
+ * This procedure is invoked by Tcl when the "send" command
+ * is deleted in an interpreter. It unregisters the interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter given by riPtr is unregistered.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteProc(clientData)
+ ClientData clientData; /* Info about registration, passed
+ * as ClientData. */
+{
+ RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
+ register RegisteredInterp *riPtr2;
+ NameRegistry *regPtr;
+
+ regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
+ RegDeleteName(regPtr, riPtr->name);
+ RegClose(regPtr);
+
+ if (registry == riPtr) {
+ registry = riPtr->nextPtr;
+ } else {
+ for (riPtr2 = registry; riPtr2 != NULL;
+ riPtr2 = riPtr2->nextPtr) {
+ if (riPtr2->nextPtr == riPtr) {
+ riPtr2->nextPtr = riPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ ckfree((char *) riPtr->name);
+ riPtr->interp = NULL;
+ UpdateCommWindow(riPtr->dispPtr);
+ Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SendRestrictProc --
+ *
+ * This procedure filters incoming events when a "send" command
+ * is outstanding. It defers all events except those containing
+ * send commands and results.
+ *
+ * Results:
+ * False is returned except for property-change events on a
+ * commWindow.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static Tk_RestrictAction
+SendRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Not used. */
+ register XEvent *eventPtr; /* Event that just arrived. */
+{
+ TkDisplay *dispPtr;
+
+ if (eventPtr->type != PropertyNotify) {
+ return TK_DEFER_EVENT;
+ }
+ for (dispPtr = tkDisplayList; dispPtr != NULL; dispPtr = dispPtr->nextPtr) {
+ if ((eventPtr->xany.display == dispPtr->display)
+ && (eventPtr->xproperty.window
+ == Tk_WindowId(dispPtr->commTkwin))) {
+ return TK_PROCESS_EVENT;
+ }
+ }
+ return TK_DEFER_EVENT;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCommWindow --
+ *
+ * This procedure updates the list of application names stored
+ * on our commWindow. It is typically called when interpreters
+ * are registered and unregistered.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The TK_APPLICATION property on the comm window is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateCommWindow(dispPtr)
+ TkDisplay *dispPtr; /* Display whose commWindow is to be
+ * updated. */
+{
+ Tcl_DString names;
+ RegisteredInterp *riPtr;
+
+ Tcl_DStringInit(&names);
+ for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
+ Tcl_DStringAppendElement(&names, riPtr->name);
+ }
+ XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
+ dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
+ (unsigned char *) Tcl_DStringValue(&names),
+ Tcl_DStringLength(&names));
+ Tcl_DStringFree(&names);
+}
diff --git a/tk/generic/tkSquare.c b/tk/generic/tkSquare.c
index 50484528d30..983969c1f4d 100644
--- a/tk/generic/tkSquare.c
+++ b/tk/generic/tkSquare.c
@@ -1,14 +1,13 @@
/*
* tkSquare.c --
*
- * This module implements "square" widgets. A "square" is
- * a widget that displays a single square that can be moved
- * around and resized. This file is intended as an example
+ * 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) 1991-1994 The Regents of the University of California.
- * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * 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.
@@ -17,7 +16,9 @@
*/
#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
@@ -31,22 +32,24 @@ typedef struct {
Display *display; /* X's token for the window's display. */
Tcl_Interp *interp; /* Interpreter associated with widget. */
Tcl_Command widgetCmd; /* Token for square's widget command. */
- int x, y; /* Position of square's upper-left corner
+ Tk_OptionTable optionTable; /* Token representing the configuration
+ * specifications. */
+ Tcl_Obj *xPtr, *yPtr; /* Position of square's upper-left corner
* within widget. */
- int size; /* Width and height of square. */
+ int x, y;
+ Tcl_Obj *sizeObjPtr; /* Width and height of square. */
/*
* Information used when displaying widget:
*/
- int borderWidth; /* Width of 3-D border around whole widget. */
- Tk_3DBorder bgBorder; /* Used for drawing background. */
- Tk_3DBorder fgBorder; /* For drawing square. */
- int relief; /* Indicates whether window as a whole is
- * raised, sunken, or flat. */
+ 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. */
- int doubleBuffer; /* Non-zero means double-buffer redisplay
+ 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
@@ -57,49 +60,52 @@ typedef struct {
* Information used for argv parsing.
*/
-static Tk_ConfigSpec configSpecs[] = {
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- "#d9d9d9", Tk_Offset(Square, bgBorder), TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-background", "background", "Background",
- "white", Tk_Offset(Square, bgBorder), TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
- "2", Tk_Offset(Square, borderWidth), 0},
- {TK_CONFIG_INT, "-dbl", "doubleBuffer", "DoubleBuffer",
- "1", Tk_Offset(Square, doubleBuffer), 0},
- {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
- (char *) NULL, 0, 0},
- {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
- "#b03060", Tk_Offset(Square, fgBorder), TK_CONFIG_COLOR_ONLY},
- {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground",
- "black", Tk_Offset(Square, fgBorder), TK_CONFIG_MONO_ONLY},
- {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
- "raised", Tk_Offset(Square, relief), 0},
- {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
- (char *) NULL, 0, 0}
+static Tk_OptionSpec configSpecs[] = {
+ {TK_OPTION_BORDER, "-background", "background", "Background",
+ "#d9d9d9", Tk_Offset(Square, bgBorderPtr), -1, 0,
+ (ClientData) "white"},
+ {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth"},
+ {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-background"},
+ {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ "2", Tk_Offset(Square, borderWidthPtr), -1},
+ {TK_OPTION_BOOLEAN, "-dbl", "doubleBuffer", "DoubleBuffer",
+ "1", Tk_Offset(Square, doubleBufferPtr), -1},
+ {TK_OPTION_SYNONYM, "-fg", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-foreground"},
+ {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground",
+ "#b03060", Tk_Offset(Square, fgBorderPtr), -1, 0,
+ (ClientData) "black"},
+ {TK_OPTION_PIXELS, "-posx", "posx", "PosX", "0",
+ Tk_Offset(Square, xPtr), -1},
+ {TK_OPTION_PIXELS, "-posy", "posy", "PosY", "0",
+ Tk_Offset(Square, yPtr), -1},
+ {TK_OPTION_RELIEF, "-relief", "relief", "Relief",
+ "raised", Tk_Offset(Square, reliefPtr), -1},
+ {TK_OPTION_PIXELS, "-size", "size", "Size", "20",
+ Tk_Offset(Square, sizeObjPtr), -1},
+ {TK_OPTION_END}
};
/*
* Forward declarations for procedures defined later in this file:
*/
-int SquareCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-static void SquareCmdDeletedProc _ANSI_ARGS_((
+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, int argc, char **argv,
- int flags));
+ 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 SquareEventProc _ANSI_ARGS_((ClientData clientData,
+static void SquareObjEventProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
static int SquareWidgetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *, int argc, char **argv));
+ Tcl_Interp *, int objc, Tcl_Obj * CONST objv[]));
/*
*--------------------------------------------------------------
@@ -119,24 +125,41 @@ static int SquareWidgetCmd _ANSI_ARGS_((ClientData clientData,
*/
int
-SquareCmd(clientData, interp, argc, argv)
+SquareObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
- Tk_Window main = (Tk_Window) clientData;
Square *squarePtr;
Tk_Window tkwin;
+ Tk_OptionTable optionTable = (Tk_OptionTable) clientData;
+ Tcl_CmdInfo info;
+ char *commandName;
+
+ if (optionTable == NULL) {
+ /*
+ * The first time this procedure is invoked, optionTable will
+ * be NULL. We then create the option table from the template
+ * and store the table pointer as the command's clinical so
+ * we'll have easy access to it in the future.
+ */
+
+ optionTable = Tk_CreateOptionTable(interp, configSpecs);
+ commandName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
+ Tcl_GetCommandInfo(interp, commandName, &info);
+ info.clientData = (ClientData) optionTable;
+ Tcl_SetCommandInfo(interp, commandName, &info);
+ }
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " pathName ?options?\"", (char *) NULL);
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");
return TCL_ERROR;
}
- tkwin = Tk_CreateWindowFromPath(interp, main, argv[1], (char *) NULL);
+ tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),
+ Tcl_GetStringFromObj(objv[1], NULL), (char *) NULL);
if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -150,29 +173,47 @@ SquareCmd(clientData, interp, argc, argv)
squarePtr->tkwin = tkwin;
squarePtr->display = Tk_Display(tkwin);
squarePtr->interp = interp;
- squarePtr->widgetCmd = Tcl_CreateCommand(interp,
+ squarePtr->widgetCmd = Tcl_CreateObjCommand(interp,
Tk_PathName(squarePtr->tkwin), SquareWidgetCmd,
- (ClientData) squarePtr, SquareCmdDeletedProc);
+ (ClientData) squarePtr, SquareDeletedProc);
+ squarePtr->xPtr = NULL;
+ squarePtr->yPtr = NULL;
squarePtr->x = 0;
squarePtr->y = 0;
- squarePtr->size = 20;
- squarePtr->borderWidth = 0;
- squarePtr->bgBorder = NULL;
- squarePtr->fgBorder = NULL;
- squarePtr->relief = TK_RELIEF_FLAT;
+ squarePtr->sizeObjPtr = NULL;
+ squarePtr->borderWidthPtr = NULL;
+ squarePtr->bgBorderPtr = NULL;
+ squarePtr->fgBorderPtr = NULL;
+ squarePtr->reliefPtr = NULL;
squarePtr->gc = None;
- squarePtr->doubleBuffer = 1;
+ squarePtr->doubleBufferPtr = NULL;
squarePtr->updatePending = 0;
+ squarePtr->optionTable = optionTable;
- Tk_CreateEventHandler(squarePtr->tkwin, ExposureMask|StructureNotifyMask,
- SquareEventProc, (ClientData) squarePtr);
- if (SquareConfigure(interp, squarePtr, argc-2, argv+2, 0) != TCL_OK) {
+ if (Tk_InitOptions(interp, (char *) squarePtr, optionTable, tkwin)
+ != TCL_OK) {
Tk_DestroyWindow(squarePtr->tkwin);
+ ckfree((char *) squarePtr);
return TCL_ERROR;
}
- interp->result = Tk_PathName(squarePtr->tkwin);
+ 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;
}
/*
@@ -194,92 +235,79 @@ SquareCmd(clientData, interp, argc, argv)
*/
static int
-SquareWidgetCmd(clientData, interp, argc, argv)
+SquareWidgetCmd(clientData, interp, objc, objv)
ClientData clientData; /* Information about square widget. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj * CONST objv[]; /* Argument objects. */
{
Square *squarePtr = (Square *) clientData;
int result = TCL_OK;
- size_t length;
- char c;
+ static char *squareOptions[] = {"cget", "configure", (char *) NULL};
+ enum {
+ SQUARE_CGET, SQUARE_CONFIGURE
+ };
+ Tcl_Obj *resultObjPtr;
+ int index;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
- if (argc < 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ if (Tcl_GetIndexFromObj(interp, objv[1], squareOptions, "command",
+ 0, &index) != TCL_OK) {
return TCL_ERROR;
}
+
Tcl_Preserve((ClientData) squarePtr);
- c = argv[1][0];
- length = strlen(argv[1]);
- if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
- && (length >= 2)) {
- if (argc != 3) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " cget option\"",
- (char *) NULL);
- goto error;
- }
- result = Tk_ConfigureValue(interp, squarePtr->tkwin, configSpecs,
- (char *) squarePtr, argv[2], 0);
- } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
- && (length >= 2)) {
- if (argc == 2) {
- result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,
- (char *) squarePtr, (char *) NULL, 0);
- } else if (argc == 3) {
- result = Tk_ConfigureInfo(interp, squarePtr->tkwin, configSpecs,
- (char *) squarePtr, argv[2], 0);
- } else {
- result = SquareConfigure(interp, squarePtr, argc-2, argv+2,
- TK_CONFIG_ARGV_ONLY);
- }
- } else if ((c == 'p') && (strncmp(argv[1], "position", length) == 0)) {
- if ((argc != 2) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " position ?x y?\"", (char *) NULL);
- goto error;
- }
- if (argc == 4) {
- if ((Tk_GetPixels(interp, squarePtr->tkwin, argv[2],
- &squarePtr->x) != TCL_OK) || (Tk_GetPixels(interp,
- squarePtr->tkwin, argv[3], &squarePtr->y) != TCL_OK)) {
+
+ switch (index) {
+ case SQUARE_CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
goto error;
}
- KeepInWindow(squarePtr);
- }
- sprintf(interp->result, "%d %d", squarePtr->x, squarePtr->y);
- } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)) {
- if ((argc != 2) && (argc != 3)) {
- Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " size ?amount?\"", (char *) NULL);
- goto error;
+ resultObjPtr = Tk_GetOptionValue(interp, (char *) squarePtr,
+ squarePtr->optionTable, objv[2], squarePtr->tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ break;
}
- if (argc == 3) {
- int i;
-
- if (Tk_GetPixels(interp, squarePtr->tkwin, argv[2], &i) != TCL_OK) {
- goto error;
+ 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 ((i <= 0) || (i > 100)) {
- Tcl_AppendResult(interp, "bad size \"", argv[2],
- "\"", (char *) NULL);
- goto error;
+ if (resultObjPtr != NULL) {
+ Tcl_SetObjResult(interp, resultObjPtr);
}
- squarePtr->size = i;
- KeepInWindow(squarePtr);
}
- sprintf(interp->result, "%d", squarePtr->size);
- } else {
- Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be cget, configure, position, or size",
- (char *) NULL);
- goto error;
- }
- if (!squarePtr->updatePending) {
- Tcl_DoWhenIdle(SquareDisplay, (ClientData) squarePtr);
- squarePtr->updatePending = 1;
}
Tcl_Release((ClientData) squarePtr);
return result;
@@ -300,7 +328,7 @@ SquareWidgetCmd(clientData, interp, argc, argv)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as colors, border width,
@@ -311,27 +339,25 @@ SquareWidgetCmd(clientData, interp, argc, argv)
*/
static int
-SquareConfigure(interp, squarePtr, argc, argv, flags)
+SquareConfigure(interp, squarePtr)
Tcl_Interp *interp; /* Used for error reporting. */
Square *squarePtr; /* Information about widget. */
- int argc; /* Number of valid entries in argv. */
- char **argv; /* Arguments. */
- int flags; /* Flags to pass to
- * Tk_ConfigureWidget. */
{
- if (Tk_ConfigureWidget(interp, squarePtr->tkwin, configSpecs,
- argc, argv, (char *) squarePtr, flags) != TCL_OK) {
- return TCL_ERROR;
- }
+ 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(squarePtr->bgBorder)->pixel);
- if ((squarePtr->gc == None) && (squarePtr->doubleBuffer)) {
+ Tk_3DBorderColor(bgBorder)->pixel);
+ Tcl_GetBooleanFromObj(NULL, squarePtr->doubleBufferPtr, &doubleBuffer);
+ if ((squarePtr->gc == None) && (doubleBuffer)) {
XGCValues gcValues;
gcValues.function = GXcopy;
gcValues.graphics_exposures = False;
@@ -345,18 +371,21 @@ SquareConfigure(interp, squarePtr, argc, argv, flags)
*/
Tk_GeometryRequest(squarePtr->tkwin, 200, 150);
- Tk_SetInternalBorder(squarePtr->tkwin, squarePtr->borderWidth);
+ 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;
}
/*
*--------------------------------------------------------------
*
- * SquareEventProc --
+ * SquareObjEventProc --
*
* This procedure is invoked by the Tk dispatcher for various
* events on squares.
@@ -372,7 +401,7 @@ SquareConfigure(interp, squarePtr, argc, argv, flags)
*/
static void
-SquareEventProc(clientData, eventPtr)
+SquareObjEventProc(clientData, eventPtr)
ClientData clientData; /* Information about window. */
XEvent *eventPtr; /* Information about event. */
{
@@ -391,6 +420,11 @@ SquareEventProc(clientData, eventPtr)
}
} 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);
@@ -405,7 +439,7 @@ SquareEventProc(clientData, eventPtr)
/*
*----------------------------------------------------------------------
*
- * SquareCmdDeletedProc --
+ * SquareDeletedProc --
*
* This procedure is invoked when a widget command is deleted. If
* the widget isn't already in the process of being destroyed,
@@ -421,7 +455,7 @@ SquareEventProc(clientData, eventPtr)
*/
static void
-SquareCmdDeletedProc(clientData)
+SquareDeletedProc(clientData)
ClientData clientData; /* Pointer to widget record for widget. */
{
Square *squarePtr = (Square *) clientData;
@@ -435,7 +469,6 @@ SquareCmdDeletedProc(clientData)
*/
if (tkwin != NULL) {
- squarePtr->tkwin = NULL;
Tk_DestroyWindow(tkwin);
}
}
@@ -466,6 +499,9 @@ SquareDisplay(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)) {
@@ -476,7 +512,8 @@ SquareDisplay(clientData)
* Create a pixmap for double-buffering, if necessary.
*/
- if (squarePtr->doubleBuffer) {
+ 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)));
@@ -489,22 +526,29 @@ SquareDisplay(clientData)
* Redraw the widget's background and border.
*/
- Tk_Fill3DRectangle(tkwin, d, squarePtr->bgBorder, 0, 0, Tk_Width(tkwin),
- Tk_Height(tkwin), squarePtr->borderWidth, squarePtr->relief);
+ 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_Fill3DRectangle(tkwin, d, squarePtr->fgBorder, squarePtr->x,
- squarePtr->y, squarePtr->size, squarePtr->size,
- squarePtr->borderWidth, TK_RELIEF_RAISED);
+ 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 (squarePtr->doubleBuffer) {
+ if (doubleBuffer) {
XCopyArea(Tk_Display(tkwin), pm, Tk_WindowId(tkwin), squarePtr->gc,
0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
0, 0);
@@ -535,11 +579,7 @@ SquareDestroy(memPtr)
char *memPtr; /* Info about square widget. */
{
Square *squarePtr = (Square *) memPtr;
-
- Tk_FreeOptions(configSpecs, (char *) squarePtr, squarePtr->display, 0);
- if (squarePtr->gc != None) {
- Tk_FreeGC(squarePtr->display, squarePtr->gc);
- }
+
ckfree((char *) squarePtr);
}
@@ -565,16 +605,26 @@ static void
KeepInWindow(squarePtr)
register Square *squarePtr; /* Pointer to widget record. */
{
- int i, bd;
+ 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 (squarePtr->relief != TK_RELIEF_FLAT) {
- bd = squarePtr->borderWidth;
+ if (relief != TK_RELIEF_FLAT) {
+ bd = borderWidth;
}
- i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + squarePtr->size);
+ i = (Tk_Width(squarePtr->tkwin) - bd) - (squarePtr->x + size);
if (i < 0) {
squarePtr->x += i;
}
- i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + squarePtr->size);
+ i = (Tk_Height(squarePtr->tkwin) - bd) - (squarePtr->y + size);
if (i < 0) {
squarePtr->y += i;
}
@@ -585,3 +635,4 @@ KeepInWindow(squarePtr)
squarePtr->y = bd;
}
}
+
diff --git a/tk/generic/tkStubImg.c b/tk/generic/tkStubImg.c
new file mode 100644
index 00000000000..024e581c578
--- /dev/null
+++ b/tk/generic/tkStubImg.c
@@ -0,0 +1,75 @@
+/*
+ * 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 */
+ }
+ }
+ 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/tk/generic/tkStubInit.c b/tk/generic/tkStubInit.c
new file mode 100644
index 00000000000..5dc7b43920a
--- /dev/null
+++ b/tk/generic/tkStubInit.c
@@ -0,0 +1,954 @@
+/*
+ * 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"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+#ifdef MAC_TCL
+#include "tkMacInt.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 */
+ TkSetClassProcs, /* 84 */
+ TkSetWindowMenuBar, /* 85 */
+ TkStringToKeysym, /* 86 */
+ TkThickPolyLineToArea, /* 87 */
+ TkWmAddToColormapWindows, /* 88 */
+ TkWmDeadWindow, /* 89 */
+ TkWmFocusToplevel, /* 90 */
+ TkWmMapWindow, /* 91 */
+ TkWmNewWindow, /* 92 */
+ TkWmProtocolEventProc, /* 93 */
+ TkWmRemoveFromColormapWindows, /* 94 */
+ TkWmRestackToplevel, /* 95 */
+ TkWmSetClass, /* 96 */
+ TkWmUnmapWindow, /* 97 */
+ TkDebugBitmap, /* 98 */
+ TkDebugBorder, /* 99 */
+ TkDebugCursor, /* 100 */
+ TkDebugColor, /* 101 */
+ TkDebugConfig, /* 102 */
+ TkDebugFont, /* 103 */
+ TkFindStateNumObj, /* 104 */
+ TkGetBitmapPredefTable, /* 105 */
+ TkGetDisplayList, /* 106 */
+ TkGetMainInfoList, /* 107 */
+ TkGetWindowFromObj, /* 108 */
+ TkpGetString, /* 109 */
+ TkpGetSubFonts, /* 110 */
+ TkpGetSystemDefault, /* 111 */
+ TkpMenuThreadInit, /* 112 */
+#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 */
+#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 */
+#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 */
+#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 */
+#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 */
+#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 */
+#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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 120 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 120 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkGenerateActivateEvents, /* 120 */
+#endif /* MAC_TCL */
+#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 */
+#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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 123 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 123 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpGetMS, /* 123 */
+#endif /* MAC_TCL */
+#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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 125 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 125 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkPointerDeadWindow, /* 125 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 126 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 126 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpSetCapture, /* 126 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 127 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 127 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpSetCursor, /* 127 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 128 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 128 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkpWmSetState, /* 128 */
+#endif /* MAC_TCL */
+ NULL, /* 129 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 130 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 130 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkGetTransientMaster, /* 130 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 131 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 131 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkGenerateButtonEvent, /* 131 */
+#endif /* MAC_TCL */
+ NULL, /* 132 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 133 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 133 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkGenWMDestroyEvent, /* 133 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ NULL, /* 134 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ NULL, /* 134 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ TkGenWMConfigureEvent, /* 134 */
+#endif /* MAC_TCL */
+ TkpDrawHighlightBorder, /* 135 */
+ TkSetFocusWin, /* 136 */
+ TkpSetKeycodeAndState, /* 137 */
+ TkpGetKeySym, /* 138 */
+ TkpInitKeymapInfo, /* 139 */
+};
+
+TkIntPlatStubs tkIntPlatStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+ TkCreateXEventSource, /* 0 */
+ TkFreeWindowId, /* 1 */
+ TkInitXId, /* 2 */
+ TkpCmapStressed, /* 3 */
+ TkpSync, /* 4 */
+ TkUnixContainerId, /* 5 */
+ TkUnixDoOneXEvent, /* 6 */
+ TkUnixSetMenubar, /* 7 */
+#endif /* UNIX */
+#ifdef __WIN32__
+ TkAlignImageData, /* 0 */
+ 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 */
+ TkpCreateNativeBitmap, /* 1 */
+ TkpDefineNativeBitmaps, /* 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 */
+ TkGenWMConfigureEvent, /* 17 */
+ TkMacButtonKeyState, /* 18 */
+ TkMacClearMenubarActive, /* 19 */
+ TkMacConvertEvent, /* 20 */
+ TkMacDispatchMenuEvent, /* 21 */
+ TkMacInstallCursor, /* 22 */
+ TkMacConvertTkEvent, /* 23 */
+ TkMacHandleTearoffMenu, /* 24 */
+ NULL, /* 25 */
+ TkMacInvalClipRgns, /* 26 */
+ TkMacDoHLEvent, /* 27 */
+ NULL, /* 28 */
+ TkMacGenerateTime, /* 29 */
+ TkMacGetDrawablePort, /* 30 */
+ TkMacGetScrollbarGrowWindow, /* 31 */
+ TkMacGetXWindow, /* 32 */
+ TkMacGrowToplevel, /* 33 */
+ TkMacHandleMenuSelect, /* 34 */
+ TkMacHaveAppearance, /* 35 */
+ TkMacInitAppleEvents, /* 36 */
+ TkMacInitMenus, /* 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 */
+#endif /* MAC_TCL */
+};
+
+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 */
+};
+
+TkPlatStubs tkPlatStubs = {
+ TCL_STUB_MAGIC,
+ NULL,
+#ifdef __WIN32__
+ Tk_AttachHWND, /* 0 */
+ Tk_GetHINSTANCE, /* 1 */
+ Tk_GetHWND, /* 2 */
+ Tk_HWNDToWindow, /* 3 */
+ Tk_PointerEvent, /* 4 */
+ Tk_TranslateWinEvent, /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+ Tk_MacSetEmbedHandler, /* 0 */
+ Tk_MacTurnOffMenus, /* 1 */
+ Tk_MacTkOwnsCursor, /* 2 */
+ TkMacInitMenus, /* 3 */
+ TkMacInitAppleEvents, /* 4 */
+ TkMacConvertEvent, /* 5 */
+ TkMacConvertTkEvent, /* 6 */
+ TkGenWMConfigureEvent, /* 7 */
+ TkMacInvalClipRgns, /* 8 */
+ TkMacHaveAppearance, /* 9 */
+ TkMacGetDrawablePort, /* 10 */
+#endif /* MAC_TCL */
+};
+
+static TkStubHooks tkStubHooks = {
+ &tkPlatStubs,
+ &tkIntStubs,
+ &tkIntPlatStubs,
+ &tkIntXlibStubs
+};
+
+TkStubs tkStubs = {
+ TCL_STUB_MAGIC,
+ &tkStubHooks,
+ Tk_MainLoop, /* 0 */
+ Tk_3DBorderColor, /* 1 */
+ Tk_3DBorderGC, /* 2 */
+ Tk_3DHorizontalBevel, /* 3 */
+ Tk_3DVerticalBevel, /* 4 */
+ Tk_AddOption, /* 5 */
+ Tk_BindEvent, /* 6 */
+ Tk_CanvasDrawableCoords, /* 7 */
+ Tk_CanvasEventuallyRedraw, /* 8 */
+ Tk_CanvasGetCoord, /* 9 */
+ Tk_CanvasGetTextInfo, /* 10 */
+ Tk_CanvasPsBitmap, /* 11 */
+ Tk_CanvasPsColor, /* 12 */
+ Tk_CanvasPsFont, /* 13 */
+ Tk_CanvasPsPath, /* 14 */
+ Tk_CanvasPsStipple, /* 15 */
+ Tk_CanvasPsY, /* 16 */
+ Tk_CanvasSetStippleOrigin, /* 17 */
+ Tk_CanvasTagsParseProc, /* 18 */
+ Tk_CanvasTagsPrintProc, /* 19 */
+ Tk_CanvasTkwin, /* 20 */
+ Tk_CanvasWindowCoords, /* 21 */
+ Tk_ChangeWindowAttributes, /* 22 */
+ Tk_CharBbox, /* 23 */
+ Tk_ClearSelection, /* 24 */
+ Tk_ClipboardAppend, /* 25 */
+ Tk_ClipboardClear, /* 26 */
+ Tk_ConfigureInfo, /* 27 */
+ Tk_ConfigureValue, /* 28 */
+ Tk_ConfigureWidget, /* 29 */
+ Tk_ConfigureWindow, /* 30 */
+ Tk_ComputeTextLayout, /* 31 */
+ Tk_CoordsToWindow, /* 32 */
+ Tk_CreateBinding, /* 33 */
+ Tk_CreateBindingTable, /* 34 */
+ Tk_CreateErrorHandler, /* 35 */
+ Tk_CreateEventHandler, /* 36 */
+ Tk_CreateGenericHandler, /* 37 */
+ Tk_CreateImageType, /* 38 */
+ Tk_CreateItemType, /* 39 */
+ Tk_CreatePhotoImageFormat, /* 40 */
+ Tk_CreateSelHandler, /* 41 */
+ Tk_CreateWindow, /* 42 */
+ Tk_CreateWindowFromPath, /* 43 */
+ Tk_DefineBitmap, /* 44 */
+ Tk_DefineCursor, /* 45 */
+ Tk_DeleteAllBindings, /* 46 */
+ Tk_DeleteBinding, /* 47 */
+ Tk_DeleteBindingTable, /* 48 */
+ Tk_DeleteErrorHandler, /* 49 */
+ Tk_DeleteEventHandler, /* 50 */
+ Tk_DeleteGenericHandler, /* 51 */
+ Tk_DeleteImage, /* 52 */
+ Tk_DeleteSelHandler, /* 53 */
+ Tk_DestroyWindow, /* 54 */
+ Tk_DisplayName, /* 55 */
+ Tk_DistanceToTextLayout, /* 56 */
+ Tk_Draw3DPolygon, /* 57 */
+ Tk_Draw3DRectangle, /* 58 */
+ Tk_DrawChars, /* 59 */
+ Tk_DrawFocusHighlight, /* 60 */
+ Tk_DrawTextLayout, /* 61 */
+ Tk_Fill3DPolygon, /* 62 */
+ Tk_Fill3DRectangle, /* 63 */
+ Tk_FindPhoto, /* 64 */
+ Tk_FontId, /* 65 */
+ Tk_Free3DBorder, /* 66 */
+ Tk_FreeBitmap, /* 67 */
+ Tk_FreeColor, /* 68 */
+ Tk_FreeColormap, /* 69 */
+ Tk_FreeCursor, /* 70 */
+ Tk_FreeFont, /* 71 */
+ Tk_FreeGC, /* 72 */
+ Tk_FreeImage, /* 73 */
+ Tk_FreeOptions, /* 74 */
+ Tk_FreePixmap, /* 75 */
+ Tk_FreeTextLayout, /* 76 */
+ Tk_FreeXId, /* 77 */
+ Tk_GCForColor, /* 78 */
+ Tk_GeometryRequest, /* 79 */
+ Tk_Get3DBorder, /* 80 */
+ Tk_GetAllBindings, /* 81 */
+ Tk_GetAnchor, /* 82 */
+ Tk_GetAtomName, /* 83 */
+ Tk_GetBinding, /* 84 */
+ Tk_GetBitmap, /* 85 */
+ Tk_GetBitmapFromData, /* 86 */
+ Tk_GetCapStyle, /* 87 */
+ Tk_GetColor, /* 88 */
+ Tk_GetColorByValue, /* 89 */
+ Tk_GetColormap, /* 90 */
+ Tk_GetCursor, /* 91 */
+ Tk_GetCursorFromData, /* 92 */
+ Tk_GetFont, /* 93 */
+ Tk_GetFontFromObj, /* 94 */
+ Tk_GetFontMetrics, /* 95 */
+ Tk_GetGC, /* 96 */
+ Tk_GetImage, /* 97 */
+ Tk_GetImageMasterData, /* 98 */
+ Tk_GetItemTypes, /* 99 */
+ Tk_GetJoinStyle, /* 100 */
+ Tk_GetJustify, /* 101 */
+ Tk_GetNumMainWindows, /* 102 */
+ Tk_GetOption, /* 103 */
+ Tk_GetPixels, /* 104 */
+ Tk_GetPixmap, /* 105 */
+ Tk_GetRelief, /* 106 */
+ Tk_GetRootCoords, /* 107 */
+ Tk_GetScrollInfo, /* 108 */
+ Tk_GetScreenMM, /* 109 */
+ Tk_GetSelection, /* 110 */
+ Tk_GetUid, /* 111 */
+ Tk_GetVisual, /* 112 */
+ Tk_GetVRootGeometry, /* 113 */
+ Tk_Grab, /* 114 */
+ Tk_HandleEvent, /* 115 */
+ Tk_IdToWindow, /* 116 */
+ Tk_ImageChanged, /* 117 */
+ Tk_Init, /* 118 */
+ Tk_InternAtom, /* 119 */
+ Tk_IntersectTextLayout, /* 120 */
+ Tk_MaintainGeometry, /* 121 */
+ Tk_MainWindow, /* 122 */
+ Tk_MakeWindowExist, /* 123 */
+ Tk_ManageGeometry, /* 124 */
+ Tk_MapWindow, /* 125 */
+ Tk_MeasureChars, /* 126 */
+ Tk_MoveResizeWindow, /* 127 */
+ Tk_MoveWindow, /* 128 */
+ Tk_MoveToplevelWindow, /* 129 */
+ Tk_NameOf3DBorder, /* 130 */
+ Tk_NameOfAnchor, /* 131 */
+ Tk_NameOfBitmap, /* 132 */
+ Tk_NameOfCapStyle, /* 133 */
+ Tk_NameOfColor, /* 134 */
+ Tk_NameOfCursor, /* 135 */
+ Tk_NameOfFont, /* 136 */
+ Tk_NameOfImage, /* 137 */
+ Tk_NameOfJoinStyle, /* 138 */
+ Tk_NameOfJustify, /* 139 */
+ Tk_NameOfRelief, /* 140 */
+ Tk_NameToWindow, /* 141 */
+ Tk_OwnSelection, /* 142 */
+ Tk_ParseArgv, /* 143 */
+ Tk_PhotoPutBlock, /* 144 */
+ Tk_PhotoPutZoomedBlock, /* 145 */
+ Tk_PhotoGetImage, /* 146 */
+ Tk_PhotoBlank, /* 147 */
+ Tk_PhotoExpand, /* 148 */
+ Tk_PhotoGetSize, /* 149 */
+ Tk_PhotoSetSize, /* 150 */
+ Tk_PointToChar, /* 151 */
+ Tk_PostscriptFontName, /* 152 */
+ Tk_PreserveColormap, /* 153 */
+ Tk_QueueWindowEvent, /* 154 */
+ Tk_RedrawImage, /* 155 */
+ Tk_ResizeWindow, /* 156 */
+ Tk_RestackWindow, /* 157 */
+ Tk_RestrictEvents, /* 158 */
+ Tk_SafeInit, /* 159 */
+ Tk_SetAppName, /* 160 */
+ Tk_SetBackgroundFromBorder, /* 161 */
+ Tk_SetClass, /* 162 */
+ Tk_SetGrid, /* 163 */
+ Tk_SetInternalBorder, /* 164 */
+ Tk_SetWindowBackground, /* 165 */
+ Tk_SetWindowBackgroundPixmap, /* 166 */
+ Tk_SetWindowBorder, /* 167 */
+ Tk_SetWindowBorderWidth, /* 168 */
+ Tk_SetWindowBorderPixmap, /* 169 */
+ Tk_SetWindowColormap, /* 170 */
+ Tk_SetWindowVisual, /* 171 */
+ Tk_SizeOfBitmap, /* 172 */
+ Tk_SizeOfImage, /* 173 */
+ Tk_StrictMotif, /* 174 */
+ Tk_TextLayoutToPostscript, /* 175 */
+ Tk_TextWidth, /* 176 */
+ Tk_UndefineCursor, /* 177 */
+ Tk_UnderlineChars, /* 178 */
+ Tk_UnderlineTextLayout, /* 179 */
+ Tk_Ungrab, /* 180 */
+ Tk_UnmaintainGeometry, /* 181 */
+ Tk_UnmapWindow, /* 182 */
+ Tk_UnsetGrid, /* 183 */
+ Tk_UpdatePointer, /* 184 */
+ Tk_AllocBitmapFromObj, /* 185 */
+ Tk_Alloc3DBorderFromObj, /* 186 */
+ Tk_AllocColorFromObj, /* 187 */
+ Tk_AllocCursorFromObj, /* 188 */
+ Tk_AllocFontFromObj, /* 189 */
+ Tk_CreateOptionTable, /* 190 */
+ Tk_DeleteOptionTable, /* 191 */
+ Tk_Free3DBorderFromObj, /* 192 */
+ Tk_FreeBitmapFromObj, /* 193 */
+ Tk_FreeColorFromObj, /* 194 */
+ Tk_FreeConfigOptions, /* 195 */
+ Tk_FreeSavedOptions, /* 196 */
+ Tk_FreeCursorFromObj, /* 197 */
+ Tk_FreeFontFromObj, /* 198 */
+ Tk_Get3DBorderFromObj, /* 199 */
+ Tk_GetAnchorFromObj, /* 200 */
+ Tk_GetBitmapFromObj, /* 201 */
+ Tk_GetColorFromObj, /* 202 */
+ Tk_GetCursorFromObj, /* 203 */
+ Tk_GetOptionInfo, /* 204 */
+ Tk_GetOptionValue, /* 205 */
+ Tk_GetJustifyFromObj, /* 206 */
+ Tk_GetMMFromObj, /* 207 */
+ Tk_GetPixelsFromObj, /* 208 */
+ Tk_GetReliefFromObj, /* 209 */
+ Tk_GetScrollInfoObj, /* 210 */
+ Tk_InitOptions, /* 211 */
+ Tk_MainEx, /* 212 */
+ Tk_RestoreSavedOptions, /* 213 */
+ Tk_SetOptions, /* 214 */
+ 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 */
+};
+
+/* !END!: Do not edit above this line. */
diff --git a/tk/generic/tkStubLib.c b/tk/generic/tkStubLib.c
new file mode 100644
index 00000000000..7a9e7bd0d53
--- /dev/null
+++ b/tk/generic/tkStubLib.c
@@ -0,0 +1,110 @@
+/*
+ * 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
+
+#include "tkDecls.h"
+#include "tkIntDecls.h"
+#include "tkPlatDecls.h"
+#include "tkIntPlatDecls.h"
+#include "tkIntXlibDecls.h"
+
+/*
+ * Ensure that Tk_InitStubs is built as an exported symbol. The other stub
+ * functions should be built as non-exported symbols.
+ */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+TkStubs *tkStubsPtr;
+TkPlatStubs *tkPlatStubsPtr;
+TkIntStubs *tkIntStubsPtr;
+TkIntPlatStubs *tkIntPlatStubsPtr;
+TkIntXlibStubs *tkIntXlibStubsPtr;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_InitStubs --
+ *
+ * Checks that the correct version of Tk is loaded and that it
+ * supports stubs. It then initialises the stub table pointers.
+ *
+ * Results:
+ * The actual version of Tk that satisfies the request, or
+ * NULL to indicate that an error occurred.
+ *
+ * Side effects:
+ * Sets the stub table pointers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tk_InitStubs(interp, version, exact)
+ Tcl_Interp *interp;
+ char *version;
+ int exact;
+{
+ char *actualVersion;
+
+ actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, exact,
+ (ClientData *) &tkStubsPtr);
+ if (!actualVersion) {
+ return NULL;
+ }
+
+ if (!tkStubsPtr) {
+ Tcl_SetResult(interp,
+ "This implementation of Tk does not support stubs",
+ TCL_STATIC);
+ return NULL;
+ }
+
+ tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
+ tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
+ tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
+ tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
+
+ return actualVersion;
+}
diff --git a/tk/generic/tkTest.c b/tk/generic/tkTest.c
index e33d6b62853..7fd0d5125b4 100644
--- a/tk/generic/tkTest.c
+++ b/tk/generic/tkTest.c
@@ -8,6 +8,7 @@
*
* 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.
@@ -16,7 +17,8 @@
*/
#include "tkInt.h"
-#include "tkPort.h"
+#include "tkPort.h"
+#include "tkText.h"
#ifdef __WIN32__
#include "tkWinInt.h"
@@ -59,10 +61,17 @@ typedef struct 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,
@@ -76,11 +85,12 @@ static void ImageDelete _ANSI_ARGS_((ClientData clientData));
static Tk_ImageType imageType = {
"test", /* name */
- ImageCreate, /* createProc */
+ (Tk_ImageCreateProc *) ImageCreate, /* createProc */
ImageGet, /* getProc */
ImageDisplay, /* displayProc */
ImageFree, /* freeProc */
ImageDelete, /* deleteProc */
+ (Tk_ImagePostscriptProc *) NULL,/* postscriptPtr */
(Tk_ImageType *) NULL /* nextPtr */
};
@@ -102,8 +112,8 @@ static NewApp *newAppPtr = NULL;
* Declaration for the square widget's class command procedure:
*/
-extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
+extern int SquareObjCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]));
typedef struct CBinding {
Tcl_Interp *interp;
@@ -112,6 +122,32 @@ typedef struct CBinding {
} 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:
*/
@@ -124,12 +160,23 @@ static int ImageCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestcbindCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
-#ifdef __WIN32__
-static int TestclipboardCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
-#endif
+static int TestbitmapObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestborderObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestcolorObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestcursorObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
static int TestdeleteappsCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestfontObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int TestmakeexistCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy,
@@ -138,22 +185,35 @@ static int TestmenubarCmd _ANSI_ARGS_((ClientData dummy,
static int TestmetricsCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
#endif
+static int TestobjconfigObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static int TestpropCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
static int TestsendCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
-static int TestpropCmd _ANSI_ARGS_((ClientData dummy,
+static int TesttextCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
#if !(defined(__WIN32__) || defined(MAC_TCL))
static int TestwrapperCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
#endif
+static void TrivialCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int TrivialConfigObjCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj * CONST objv[]));
+static void TrivialEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
/*
* External (platform specific) initialization routine:
*/
-EXTERN int TkplatformtestInit _ANSI_ARGS_((
- Tcl_Interp *interp));
-#ifndef MAC_TCL
+extern int TkplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+#if !(defined(__WIN32__) || defined(MAC_TCL))
#define TkplatformtestInit(x) TCL_OK
#endif
@@ -167,7 +227,7 @@ EXTERN int TkplatformtestInit _ANSI_ARGS_((
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Creates several test commands.
@@ -189,18 +249,26 @@ Tktest_Init(interp)
return TCL_ERROR;
}
- Tcl_CreateCommand(interp, "square", SquareCmd,
+ Tcl_CreateObjCommand(interp, "square", SquareObjCmd,
+ (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
-#ifdef __WIN32__
- Tcl_CreateCommand(interp, "testclipboard", TestclipboardCmd,
+ Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
-#endif
- Tcl_CreateCommand(interp, "testcbind", TestcbindCmd,
+ Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testcursor", TestcursorObjCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testdeleteapps", TestdeleteappsCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testembed", TkpTestembedCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testobjconfig", TestobjconfigObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "testfont", TestfontObjCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testmakeexist", TestmakeexistCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testmenubar", TestmenubarCmd,
@@ -213,12 +281,20 @@ Tktest_Init(interp)
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testsend", TestsendCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testtext", TesttextCmd,
+ (ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#if !(defined(__WIN32__) || defined(MAC_TCL))
Tcl_CreateCommand(interp, "testwrapper", TestwrapperCmd,
(ClientData) Tk_MainWindow(interp), (Tcl_CmdDeleteProc *) NULL);
#endif
-/*
+#ifdef TCL_THREADS
+ if (TclThread_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+#endif
+
+ /*
* Create test image type.
*/
@@ -237,48 +313,6 @@ Tktest_Init(interp)
/*
*----------------------------------------------------------------------
*
- * TestclipboardCmd --
- *
- * This procedure implements the testclipboard command. It provides
- * a way to determine the actual contents of the Windows clipboard.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef __WIN32__
-static int
-TestclipboardCmd(clientData, interp, argc, argv)
- ClientData clientData; /* Main window for application. */
- Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
-{
- TkWindow *winPtr = (TkWindow *) clientData;
- HGLOBAL handle;
- char *data;
-
- if (OpenClipboard(NULL)) {
- handle = GetClipboardData(CF_TEXT);
- if (handle != NULL) {
- data = GlobalLock(handle);
- Tcl_AppendResult(interp, data, (char *) NULL);
- GlobalUnlock(handle);
- }
- CloseClipboard();
- }
- return TCL_OK;
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
* TestcbindCmd --
*
* This procedure implements the "testcbinding" command. It provides
@@ -386,6 +420,146 @@ CBindingFreeProc(clientData)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -424,6 +598,956 @@ TestdeleteappsCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * TestobjconfigObjCmd --
+ *
+ * This procedure implements the "testobjconfig" command,
+ * which is used to test the procedures in tkConfig.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestobjconfigObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static char *options[] = {"alltypes", "chain1", "chain2",
+ "configerror", "delete", "info", "internal", "new",
+ "notenoughparams", "twowindows", (char *) NULL};
+ enum {
+ ALL_TYPES,
+ CHAIN1,
+ CHAIN2,
+ CONFIG_ERROR,
+ DEL, /* Can't use DELETE: VC++ compiler barfs. */
+ INFO,
+ INTERNAL,
+ NEW,
+ NOT_ENOUGH_PARAMS,
+ TWO_WINDOWS
+ };
+ static Tk_OptionTable tables[11]; /* Holds pointers to option tables
+ * created by commands below; indexed
+ * with same values as "options"
+ * array. */
+ Tk_Window mainWin = (Tk_Window) clientData;
+ Tk_Window tkwin;
+ int index, result = TCL_OK;
+
+ /*
+ * Structures used by the "chain1" subcommand and also shared by
+ * the "chain2" subcommand:
+ */
+
+ typedef struct ExtensionWidgetRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *base1ObjPtr;
+ Tcl_Obj *base2ObjPtr;
+ Tcl_Obj *extension3ObjPtr;
+ Tcl_Obj *extension4ObjPtr;
+ Tcl_Obj *extension5ObjPtr;
+ } ExtensionWidgetRecord;
+ static Tk_OptionSpec baseSpecs[] = {
+ {TK_OPTION_STRING,
+ "-one", "one", "One", "one",
+ Tk_Offset(ExtensionWidgetRecord, base1ObjPtr), -1},
+ {TK_OPTION_STRING,
+ "-two", "two", "Two", "two",
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr), -1},
+ {TK_OPTION_END}
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch (index) {
+ case ALL_TYPES: {
+ typedef struct TypesRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *booleanPtr;
+ Tcl_Obj *integerPtr;
+ Tcl_Obj *doublePtr;
+ Tcl_Obj *stringPtr;
+ Tcl_Obj *stringTablePtr;
+ Tcl_Obj *colorPtr;
+ Tcl_Obj *fontPtr;
+ Tcl_Obj *bitmapPtr;
+ Tcl_Obj *borderPtr;
+ Tcl_Obj *reliefPtr;
+ Tcl_Obj *cursorPtr;
+ Tcl_Obj *activeCursorPtr;
+ Tcl_Obj *justifyPtr;
+ Tcl_Obj *anchorPtr;
+ Tcl_Obj *pixelPtr;
+ Tcl_Obj *mmPtr;
+ } TypesRecord;
+ TypesRecord *recordPtr;
+ static char *stringTable[] = {"one", "two", "three", "four",
+ (char *) NULL};
+ static Tk_OptionSpec typesSpecs[] = {
+ {TK_OPTION_BOOLEAN,
+ "-boolean", "boolean", "Boolean",
+ "1", Tk_Offset(TypesRecord, booleanPtr), -1, 0, 0, 0x1},
+ {TK_OPTION_INT,
+ "-integer", "integer", "Integer",
+ "7", Tk_Offset(TypesRecord, integerPtr), -1, 0, 0, 0x2},
+ {TK_OPTION_DOUBLE,
+ "-double", "double", "Double",
+ "3.14159", Tk_Offset(TypesRecord, doublePtr), -1, 0, 0,
+ 0x4},
+ {TK_OPTION_STRING,
+ "-string", "string", "String",
+ "foo", Tk_Offset(TypesRecord, stringPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x8},
+ {TK_OPTION_STRING_TABLE,
+ "-stringtable", "StringTable", "stringTable",
+ "one", Tk_Offset(TypesRecord, stringTablePtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData) stringTable, 0x10},
+ {TK_OPTION_COLOR,
+ "-color", "color", "Color",
+ "red", Tk_Offset(TypesRecord, colorPtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
+ {TK_OPTION_FONT,
+ "-font", "font", "Font",
+ "Helvetica 12",
+ Tk_Offset(TypesRecord, fontPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x40},
+ {TK_OPTION_BITMAP,
+ "-bitmap", "bitmap", "Bitmap",
+ "gray50",
+ Tk_Offset(TypesRecord, bitmapPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x80},
+ {TK_OPTION_BORDER,
+ "-border", "border", "Border",
+ "blue", Tk_Offset(TypesRecord, borderPtr), -1,
+ TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
+ {TK_OPTION_RELIEF,
+ "-relief", "relief", "Relief",
+ "raised",
+ Tk_Offset(TypesRecord, reliefPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x200},
+ {TK_OPTION_CURSOR,
+ "-cursor", "cursor", "Cursor",
+ "xterm",
+ Tk_Offset(TypesRecord, cursorPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x400},
+ {TK_OPTION_JUSTIFY,
+ "-justify", (char *) NULL, (char *) NULL,
+ "left",
+ Tk_Offset(TypesRecord, justifyPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x800},
+ {TK_OPTION_ANCHOR,
+ "-anchor", "anchor", "Anchor",
+ (char *) NULL,
+ Tk_Offset(TypesRecord, anchorPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x1000},
+ {TK_OPTION_PIXELS,
+ "-pixel", "pixel", "Pixel",
+ "1", Tk_Offset(TypesRecord, pixelPtr), -1,
+ TK_CONFIG_NULL_OK, 0, 0x2000},
+ {TK_OPTION_SYNONYM,
+ "-synonym", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) "-color",
+ 0x8000},
+ {TK_OPTION_END}
+ };
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ optionTable = Tk_CreateOptionTable(interp,
+ typesSpecs);
+ tables[index] = optionTable;
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = (TypesRecord *) ckalloc(sizeof(TypesRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->booleanPtr = NULL;
+ recordPtr->integerPtr = NULL;
+ recordPtr->doublePtr = NULL;
+ recordPtr->stringPtr = NULL;
+ recordPtr->colorPtr = NULL;
+ recordPtr->fontPtr = NULL;
+ recordPtr->bitmapPtr = NULL;
+ recordPtr->borderPtr = NULL;
+ recordPtr->reliefPtr = NULL;
+ recordPtr->cursorPtr = NULL;
+ recordPtr->justifyPtr = NULL;
+ recordPtr->anchorPtr = NULL;
+ recordPtr->pixelPtr = NULL;
+ recordPtr->mmPtr = NULL;
+ recordPtr->stringTablePtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ optionTable, objc - 3, objv + 3, tkwin,
+ (Tk_SavedOptions *) NULL, (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ }
+ } else {
+ Tk_DestroyWindow(tkwin);
+ ckfree((char *) recordPtr);
+ }
+ if (result == TCL_OK) {
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CHAIN1: {
+ ExtensionWidgetRecord *recordPtr;
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+ optionTable = Tk_CreateOptionTable(interp, baseSpecs);
+ tables[index] = optionTable;
+
+ recordPtr = (ExtensionWidgetRecord *) ckalloc(
+ sizeof(ExtensionWidgetRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
+ recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
+ objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL,
+ (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_FreeConfigOptions((char *) recordPtr, optionTable,
+ tkwin);
+ }
+ }
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CHAIN2: {
+ ExtensionWidgetRecord *recordPtr;
+ static Tk_OptionSpec extensionSpecs[] = {
+ {TK_OPTION_STRING,
+ "-three", "three", "Three", "three",
+ Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr),
+ -1},
+ {TK_OPTION_STRING,
+ "-four", "four", "Four", "four",
+ Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr),
+ -1},
+ {TK_OPTION_STRING,
+ "-two", "two", "Two", "two and a half",
+ Tk_Offset(ExtensionWidgetRecord, base2ObjPtr),
+ -1},
+ {TK_OPTION_STRING,
+ "-oneAgain", "oneAgain", "OneAgain", "one again",
+ Tk_Offset(ExtensionWidgetRecord, extension5ObjPtr),
+ -1},
+ {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, -1, 0, (ClientData) baseSpecs}
+ };
+ Tk_Window tkwin;
+ Tk_OptionTable optionTable;
+
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+ optionTable = Tk_CreateOptionTable(interp, extensionSpecs);
+ tables[index] = optionTable;
+
+ recordPtr = (ExtensionWidgetRecord *) ckalloc(
+ sizeof(ExtensionWidgetRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->base1ObjPtr = recordPtr->base2ObjPtr = NULL;
+ recordPtr->extension3ObjPtr = recordPtr->extension4ObjPtr = NULL;
+ recordPtr->extension5ObjPtr = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr, optionTable,
+ objc - 3, objv + 3, tkwin, (Tk_SavedOptions *) NULL,
+ (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_FreeConfigOptions((char *) recordPtr, optionTable,
+ tkwin);
+ }
+ }
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case CONFIG_ERROR: {
+ typedef struct ErrorWidgetRecord {
+ Tcl_Obj *intPtr;
+ } ErrorWidgetRecord;
+ ErrorWidgetRecord widgetRecord;
+ static Tk_OptionSpec errorSpecs[] = {
+ {TK_OPTION_INT,
+ "-int", "integer", "Integer",
+ "bogus", Tk_Offset(ErrorWidgetRecord, intPtr)},
+ {TK_OPTION_END}
+ };
+ Tk_OptionTable optionTable;
+
+ widgetRecord.intPtr = NULL;
+ optionTable = Tk_CreateOptionTable(interp, errorSpecs);
+ tables[index] = optionTable;
+ return Tk_InitOptions(interp, (char *) &widgetRecord, optionTable,
+ (Tk_Window) NULL);
+ }
+
+ case DEL: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tableName");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tables[index] != NULL) {
+ Tk_DeleteOptionTable(tables[index]);
+ }
+ break;
+ }
+
+ case INFO: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "tableName");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[2], options, "table", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TkDebugConfig(interp, tables[index]));
+ break;
+ }
+
+ case INTERNAL: {
+ /*
+ * This command is similar to the "alltypes" command except
+ * that it stores all the configuration options as internal
+ * forms instead of objects.
+ */
+
+ typedef struct InternalRecord {
+ TrivialCommandHeader header;
+ int boolean;
+ int integer;
+ double doubleValue;
+ char *string;
+ int index;
+ XColor *colorPtr;
+ Tk_Font tkfont;
+ Pixmap bitmap;
+ Tk_3DBorder border;
+ int relief;
+ Tk_Cursor cursor;
+ Tk_Justify justify;
+ Tk_Anchor anchor;
+ int pixels;
+ double mm;
+ Tk_Window tkwin;
+ } InternalRecord;
+ InternalRecord *recordPtr;
+ static char *internalStringTable[] = {
+ "one", "two", "three", "four", (char *) NULL
+ };
+ static Tk_OptionSpec internalSpecs[] = {
+ {TK_OPTION_BOOLEAN,
+ "-boolean", "boolean", "Boolean",
+ "1", -1, Tk_Offset(InternalRecord, boolean), 0, 0, 0x1},
+ {TK_OPTION_INT,
+ "-integer", "integer", "Integer",
+ "148962237", -1, Tk_Offset(InternalRecord, integer),
+ 0, 0, 0x2},
+ {TK_OPTION_DOUBLE,
+ "-double", "double", "Double",
+ "3.14159", -1, Tk_Offset(InternalRecord, doubleValue),
+ 0, 0, 0x4},
+ {TK_OPTION_STRING,
+ "-string", "string", "String",
+ "foo", -1, Tk_Offset(InternalRecord, string),
+ TK_CONFIG_NULL_OK, 0, 0x8},
+ {TK_OPTION_STRING_TABLE,
+ "-stringtable", "StringTable", "stringTable",
+ "one", -1, Tk_Offset(InternalRecord, index),
+ TK_CONFIG_NULL_OK, (ClientData) internalStringTable,
+ 0x10},
+ {TK_OPTION_COLOR,
+ "-color", "color", "Color",
+ "red", -1, Tk_Offset(InternalRecord, colorPtr),
+ TK_CONFIG_NULL_OK, (ClientData) "black", 0x20},
+ {TK_OPTION_FONT,
+ "-font", "font", "Font",
+ "Helvetica 12", -1, Tk_Offset(InternalRecord, tkfont),
+ TK_CONFIG_NULL_OK, 0, 0x40},
+ {TK_OPTION_BITMAP,
+ "-bitmap", "bitmap", "Bitmap",
+ "gray50", -1, Tk_Offset(InternalRecord, bitmap),
+ TK_CONFIG_NULL_OK, 0, 0x80},
+ {TK_OPTION_BORDER,
+ "-border", "border", "Border",
+ "blue", -1, Tk_Offset(InternalRecord, border),
+ TK_CONFIG_NULL_OK, (ClientData) "white", 0x100},
+ {TK_OPTION_RELIEF,
+ "-relief", "relief", "Relief",
+ "raised", -1, Tk_Offset(InternalRecord, relief),
+ TK_CONFIG_NULL_OK, 0, 0x200},
+ {TK_OPTION_CURSOR,
+ "-cursor", "cursor", "Cursor",
+ "xterm", -1, Tk_Offset(InternalRecord, cursor),
+ TK_CONFIG_NULL_OK, 0, 0x400},
+ {TK_OPTION_JUSTIFY,
+ "-justify", (char *) NULL, (char *) NULL,
+ "left", -1, Tk_Offset(InternalRecord, justify),
+ TK_CONFIG_NULL_OK, 0, 0x800},
+ {TK_OPTION_ANCHOR,
+ "-anchor", "anchor", "Anchor",
+ (char *) NULL, -1, Tk_Offset(InternalRecord, anchor),
+ TK_CONFIG_NULL_OK, 0, 0x1000},
+ {TK_OPTION_PIXELS,
+ "-pixel", "pixel", "Pixel",
+ "1", -1, Tk_Offset(InternalRecord, pixels),
+ TK_CONFIG_NULL_OK, 0, 0x2000},
+ {TK_OPTION_WINDOW,
+ "-window", "window", "Window",
+ (char *) NULL, -1, Tk_Offset(InternalRecord, tkwin),
+ TK_CONFIG_NULL_OK, 0, 0},
+ {TK_OPTION_SYNONYM,
+ "-synonym", (char *) NULL, (char *) NULL,
+ (char *) NULL, -1, -1, 0, (ClientData) "-color",
+ 0x8000},
+ {TK_OPTION_END}
+ };
+ Tk_OptionTable optionTable;
+ Tk_Window tkwin;
+ optionTable = Tk_CreateOptionTable(interp, internalSpecs);
+ tables[index] = optionTable;
+ tkwin = Tk_CreateWindowFromPath(interp, (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = (InternalRecord *) ckalloc(sizeof(InternalRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->boolean = 0;
+ recordPtr->integer = 0;
+ recordPtr->doubleValue = 0.0;
+ recordPtr->string = NULL;
+ recordPtr->index = 0;
+ recordPtr->colorPtr = NULL;
+ recordPtr->tkfont = NULL;
+ recordPtr->bitmap = None;
+ recordPtr->border = NULL;
+ recordPtr->relief = TK_RELIEF_FLAT;
+ recordPtr->cursor = NULL;
+ recordPtr->justify = TK_JUSTIFY_LEFT;
+ recordPtr->anchor = TK_ANCHOR_N;
+ recordPtr->pixels = 0;
+ recordPtr->mm = 0.0;
+ recordPtr->tkwin = NULL;
+ result = Tk_InitOptions(interp, (char *) recordPtr, optionTable,
+ tkwin);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ optionTable, objc - 3, objv + 3, tkwin,
+ (Tk_SavedOptions *) NULL, (int *) NULL);
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ }
+ } else {
+ Tk_DestroyWindow(tkwin);
+ ckfree((char *) recordPtr);
+ }
+ if (result == TCL_OK) {
+ Tcl_SetObjResult(interp, objv[2]);
+ }
+ break;
+ }
+
+ case NEW: {
+ typedef struct FiveRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *one;
+ Tcl_Obj *two;
+ Tcl_Obj *three;
+ Tcl_Obj *four;
+ Tcl_Obj *five;
+ } FiveRecord;
+ FiveRecord *recordPtr;
+ static Tk_OptionSpec smallSpecs[] = {
+ {TK_OPTION_INT,
+ "-one", "one", "One",
+ "1",
+ Tk_Offset(FiveRecord, one), -1},
+ {TK_OPTION_INT,
+ "-two", "two", "Two",
+ "2",
+ Tk_Offset(FiveRecord, two), -1},
+ {TK_OPTION_INT,
+ "-three", "three", "Three",
+ "3",
+ Tk_Offset(FiveRecord, three), -1},
+ {TK_OPTION_INT,
+ "-four", "four", "Four",
+ "4",
+ Tk_Offset(FiveRecord, four), -1},
+ {TK_OPTION_STRING,
+ "-five", NULL, NULL,
+ NULL,
+ Tk_Offset(FiveRecord, five), -1},
+ {TK_OPTION_END}
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "new name ?options?");
+ return TCL_ERROR;
+ }
+
+ recordPtr = (FiveRecord *) ckalloc(sizeof(FiveRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
+ smallSpecs);
+ tables[index] = recordPtr->header.optionTable;
+ recordPtr->header.tkwin = NULL;
+ recordPtr->one = recordPtr->two = recordPtr->three = NULL;
+ recordPtr->four = recordPtr->five = NULL;
+ Tcl_SetObjResult(interp, objv[2]);
+ result = Tk_InitOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, (Tk_Window) NULL);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, objc - 3, objv + 3,
+ (Tk_Window) NULL, (Tk_SavedOptions *) NULL,
+ (int *) NULL);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ } else {
+ Tk_FreeConfigOptions((char *) recordPtr,
+ recordPtr->header.optionTable, (Tk_Window) NULL);
+ }
+ }
+ if (result != TCL_OK) {
+ ckfree((char *) recordPtr);
+ }
+
+ break;
+ }
+ case NOT_ENOUGH_PARAMS: {
+ typedef struct NotEnoughRecord {
+ Tcl_Obj *fooObjPtr;
+ } NotEnoughRecord;
+ NotEnoughRecord record;
+ static Tk_OptionSpec errorSpecs[] = {
+ {TK_OPTION_INT,
+ "-foo", "foo", "Foo",
+ "0", Tk_Offset(NotEnoughRecord, fooObjPtr)},
+ {TK_OPTION_END}
+ };
+ Tcl_Obj *newObjPtr = Tcl_NewStringObj("-foo", -1);
+ Tk_OptionTable optionTable;
+
+ record.fooObjPtr = NULL;
+
+ tkwin = Tk_CreateWindowFromPath(interp, mainWin,
+ ".config", (char *) NULL);
+ Tk_SetClass(tkwin, "Config");
+ optionTable = Tk_CreateOptionTable(interp, errorSpecs);
+ tables[index] = optionTable;
+ Tk_InitOptions(interp, (char *) &record, optionTable, tkwin);
+ if (Tk_SetOptions(interp, (char *) &record, optionTable,
+ 1, &newObjPtr, tkwin, (Tk_SavedOptions *) NULL,
+ (int *) NULL)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ }
+ Tcl_DecrRefCount(newObjPtr);
+ Tk_FreeConfigOptions( (char *) &record, optionTable, tkwin);
+ Tk_DestroyWindow(tkwin);
+ return result;
+ }
+
+ case TWO_WINDOWS: {
+ typedef struct SlaveRecord {
+ TrivialCommandHeader header;
+ Tcl_Obj *windowPtr;
+ } SlaveRecord;
+ SlaveRecord *recordPtr;
+ static Tk_OptionSpec slaveSpecs[] = {
+ {TK_OPTION_WINDOW,
+ "-window", "window", "Window",
+ ".bar", Tk_Offset(SlaveRecord, windowPtr), -1,
+ TK_CONFIG_NULL_OK},
+ {TK_OPTION_END}
+ };
+ Tk_Window tkwin = Tk_CreateWindowFromPath(interp,
+ (Tk_Window) clientData,
+ Tcl_GetStringFromObj(objv[2], NULL), (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_SetClass(tkwin, "Test");
+
+ recordPtr = (SlaveRecord *) ckalloc(sizeof(SlaveRecord));
+ recordPtr->header.interp = interp;
+ recordPtr->header.optionTable = Tk_CreateOptionTable(interp,
+ slaveSpecs);
+ tables[index] = recordPtr->header.optionTable;
+ recordPtr->header.tkwin = tkwin;
+ recordPtr->windowPtr = NULL;
+
+ result = Tk_InitOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, tkwin);
+ if (result == TCL_OK) {
+ result = Tk_SetOptions(interp, (char *) recordPtr,
+ recordPtr->header.optionTable, objc - 3, objv + 3,
+ tkwin, (Tk_SavedOptions *) NULL, (int *) NULL);
+ if (result == TCL_OK) {
+ recordPtr->header.widgetCmd = Tcl_CreateObjCommand(interp,
+ Tcl_GetStringFromObj(objv[2], NULL),
+ TrivialConfigObjCmd, (ClientData) recordPtr,
+ TrivialCmdDeletedProc);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TrivialEventProc, (ClientData) recordPtr);
+ Tcl_SetObjResult(interp, objv[2]);
+ } else {
+ Tk_FreeConfigOptions((char *) recordPtr,
+ recordPtr->header.optionTable, tkwin);
+ }
+ }
+ if (result != TCL_OK) {
+ Tk_DestroyWindow(tkwin);
+ ckfree((char *) recordPtr);
+ }
+
+ }
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TrivialConfigObjCmd --
+ *
+ * This command is used to test the configuration package. It only
+ * handles the "configure" and "cget" subcommands.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TrivialConfigObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ int result = TCL_OK;
+ static char *options[] = {"cget", "configure", "csave", (char *) NULL};
+ enum {
+ CGET, CONFIGURE, CSAVE
+ };
+ Tcl_Obj *resultObjPtr;
+ int index, mask;
+ TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
+ Tk_Window tkwin = headerPtr->tkwin;
+ Tk_SavedOptions saved;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "command",
+ 0, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_Preserve(clientData);
+
+ switch (index) {
+ case CGET: {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "option");
+ result = TCL_ERROR;
+ goto done;
+ }
+ resultObjPtr = Tk_GetOptionValue(interp, (char *) clientData,
+ headerPtr->optionTable, objv[2], tkwin);
+ if (resultObjPtr != NULL) {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ result = TCL_OK;
+ } else {
+ result = TCL_ERROR;
+ }
+ break;
+ }
+ case CONFIGURE: {
+ if (objc == 2) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
+ headerPtr->optionTable, (Tcl_Obj *) NULL, tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ } else if (objc == 3) {
+ resultObjPtr = Tk_GetOptionInfo(interp, (char *) clientData,
+ headerPtr->optionTable, objv[2], tkwin);
+ if (resultObjPtr == NULL) {
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, resultObjPtr);
+ }
+ } else {
+ result = Tk_SetOptions(interp, (char *) clientData,
+ headerPtr->optionTable, objc - 2, objv + 2,
+ tkwin, (Tk_SavedOptions *) NULL, &mask);
+ if (result == TCL_OK) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ }
+ }
+ break;
+ }
+ case CSAVE: {
+ result = Tk_SetOptions(interp, (char *) clientData,
+ headerPtr->optionTable, objc - 2, objv + 2,
+ tkwin, &saved, &mask);
+ Tk_FreeSavedOptions(&saved);
+ if (result == TCL_OK) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), mask);
+ }
+ break;
+ }
+ }
+done:
+ Tcl_Release(clientData);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TrivialCmdDeletedProc --
+ *
+ * This procedure is invoked when a widget command is deleted. If
+ * the widget isn't already in the process of being destroyed,
+ * this command destroys it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The widget is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TrivialCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
+ Tk_Window tkwin = headerPtr->tkwin;
+
+ if (tkwin != NULL) {
+ Tk_DestroyWindow(tkwin);
+ } else if (headerPtr->optionTable != NULL) {
+ /*
+ * This is a "new" object, which doesn't have a window, so
+ * we can't depend on cleaning up in the event procedure.
+ * Free its resources here.
+ */
+
+ Tk_FreeConfigOptions((char *) clientData,
+ headerPtr->optionTable, (Tk_Window) NULL);
+ Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TrivialEventProc --
+ *
+ * A dummy event proc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TrivialEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TrivialCommandHeader *headerPtr = (TrivialCommandHeader *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ if (headerPtr->tkwin != NULL) {
+ Tk_FreeConfigOptions((char *) clientData,
+ headerPtr->optionTable, headerPtr->tkwin);
+ headerPtr->optionTable = NULL;
+ headerPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(headerPtr->interp,
+ headerPtr->widgetCmd);
+ }
+ Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestfontObjCmd --
+ *
+ * This procedure implements the "testfont" command, which is used
+ * to test TkFont objects.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestfontObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ static char *options[] = {"counts", "subfonts", (char *) NULL};
+ enum option {COUNTS, SUBFONTS};
+ int index;
+ Tk_Window tkwin;
+ Tk_Font tkfont;
+
+ tkwin = (Tk_Window) clientData;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option fontName");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "command", 0, &index)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum option) index) {
+ case COUNTS: {
+ Tcl_SetObjResult(interp, TkDebugFont(Tk_MainWindow(interp),
+ Tcl_GetString(objv[2])));
+ break;
+ }
+ case SUBFONTS: {
+ tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
+ if (tkfont == NULL) {
+ return TCL_ERROR;
+ }
+ TkpGetSubFonts(interp, tkfont);
+ Tk_FreeFont(tkfont);
+ break;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ImageCreate --
*
* This procedure is called by the Tk image code to create "test"
@@ -439,6 +1563,7 @@ TestdeleteappsCmd(clientData, interp, argc, argv)
*/
/* ARGSUSED */
+#ifdef USE_OLD_IMAGE
static int
ImageCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
Tcl_Interp *interp; /* Interpreter for application containing
@@ -457,21 +1582,55 @@ ImageCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
char *varName;
int i;
+ Tk_InitImageArgs(interp, argc, &argv);
varName = "log";
for (i = 0; i < argc; i += 2) {
- char *arg = Tcl_GetStringFromObj(objv[i], NULL);
- if (strcmp(arg, "-variable") != 0) {
- Tcl_AppendResult(interp, "bad option name \"", arg,
- "\"", (char *) NULL);
+ 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 \"", arg,
- "\" option", (char *) NULL);
+ Tcl_AppendResult(interp, "no value given for \"",
+ argv[i], "\" option", (char *) NULL);
return TCL_ERROR;
}
varName = Tcl_GetStringFromObj(objv[i+1], NULL);
}
+#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;
@@ -524,7 +1683,8 @@ ImageCmd(clientData, interp, argc, argv)
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",
+ argv[0],
+ " changed x y width height imageWidth imageHeight",
(char *) NULL);
return TCL_ERROR;
}
@@ -618,7 +1778,7 @@ ImageDisplay(clientData, display, drawable, imageX, imageY, width, height,
* imageX and imageY. */
{
TImageInstance *instPtr = (TImageInstance *) clientData;
- char buffer[200];
+ char buffer[200 + TCL_INTEGER_SPACE * 6];
sprintf(buffer, "%s display %d %d %d %d %d %d",
instPtr->masterPtr->imageName, imageX, imageY, width, height,
@@ -735,12 +1895,12 @@ TestmakeexistCmd(clientData, interp, argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
- Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window mainWin = (Tk_Window) clientData;
int i;
Tk_Window tkwin;
for (i = 1; i < argc; i++) {
- tkwin = Tk_NameToWindow(interp, argv[i], mainwin);
+ tkwin = Tk_NameToWindow(interp, argv[i], mainWin);
if (tkwin == NULL) {
return TCL_ERROR;
}
@@ -777,7 +1937,7 @@ TestmenubarCmd(clientData, interp, argc, argv)
char **argv; /* Argument strings. */
{
#ifdef __UNIX__
- Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window mainWin = (Tk_Window) clientData;
Tk_Window tkwin, menubar;
if (argc < 2) {
@@ -792,14 +1952,14 @@ TestmenubarCmd(clientData, interp, argc, argv)
"window toplevel menubar\"", (char *) NULL);
return TCL_ERROR;
}
- tkwin = Tk_NameToWindow(interp, argv[2], mainwin);
+ 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);
+ menubar = Tk_NameToWindow(interp, argv[3], mainWin);
if (menubar == NULL) {
return TCL_ERROR;
}
@@ -813,7 +1973,8 @@ TestmenubarCmd(clientData, interp, argc, argv)
return TCL_OK;
#else
- interp->result = "testmenubar is supported only under Unix";
+ Tcl_SetResult(interp, "testmenubar is supported only under Unix",
+ TCL_STATIC);
return TCL_ERROR;
#endif
}
@@ -843,7 +2004,7 @@ TestmetricsCmd(clientData, interp, argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
- char buf[200];
+ char buf[TCL_INTEGER_SPACE];
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
@@ -875,7 +2036,7 @@ TestmetricsCmd(clientData, interp, argc, argv)
{
Tk_Window tkwin = (Tk_Window) clientData;
TkWindow *winPtr;
- char buf[200];
+ char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
@@ -928,7 +2089,7 @@ TestpropCmd(clientData, interp, argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
- Tk_Window mainwin = (Tk_Window) clientData;
+ Tk_Window mainWin = (Tk_Window) clientData;
int result, actualFormat;
unsigned long bytesAfter, length, value;
Atom actualType, propName;
@@ -943,9 +2104,9 @@ TestpropCmd(clientData, interp, argc, argv)
}
w = strtoul(argv[1], &end, 0);
- propName = Tk_InternAtom(mainwin, argv[2]);
+ propName = Tk_InternAtom(mainWin, argv[2]);
property = NULL;
- result = XGetWindowProperty(Tk_Display(mainwin),
+ result = XGetWindowProperty(Tk_Display(mainWin),
w, propName, 0, 100000, False, AnyPropertyType,
&actualType, &actualFormat, &length,
&bytesAfter, (unsigned char **) &property);
@@ -1006,7 +2167,9 @@ TestsendCmd(clientData, interp, argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
+#if !(defined(__WIN32__) || defined(MAC_TCL))
TkWindow *winPtr = (TkWindow *) clientData;
+#endif
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
@@ -1074,7 +2237,10 @@ TestsendCmd(clientData, interp, argc, argv)
}
}
} else if (strcmp(argv[1], "serial") == 0) {
- sprintf(interp->result, "%d", tkSendSerial+1);
+ 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);
@@ -1084,6 +2250,85 @@ TestsendCmd(clientData, interp, argc, argv)
return TCL_OK;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TesttextCmd --
+ *
+ * This procedure implements the "testtext" command. It provides
+ * a set of functions for testing text widgets and the associated
+ * functions in tkText*.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Depends on option; see below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TesttextCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkText *textPtr;
+ size_t len;
+ int lineIndex, byteIndex, byteOffset;
+ TkTextIndex index;
+ char buf[64];
+ Tcl_CmdInfo info;
+
+ if (argc < 3) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetCommandInfo(interp, argv[1], &info) == 0) {
+ return TCL_ERROR;
+ }
+ textPtr = (TkText *) info.clientData;
+ len = strlen(argv[2]);
+ if (strncmp(argv[2], "byteindex", len) == 0) {
+ if (argc != 5) {
+ return TCL_ERROR;
+ }
+ lineIndex = atoi(argv[3]) - 1;
+ byteIndex = atoi(argv[4]);
+
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, byteIndex, &index);
+ } else if (strncmp(argv[2], "forwbytes", len) == 0) {
+ if (argc != 5) {
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ byteOffset = atoi(argv[4]);
+ TkTextIndexForwBytes(&index, byteOffset, &index);
+ } else if (strncmp(argv[2], "backbytes", len) == 0) {
+ if (argc != 5) {
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ byteOffset = atoi(argv[4]);
+ TkTextIndexBackBytes(&index, byteOffset, &index);
+ } else {
+ return TCL_ERROR;
+ }
+
+ TkTextSetMark(textPtr, "insert", &index);
+ TkTextPrintIndex(&index, buf);
+ sprintf(buf + strlen(buf), " %d", index.byteIndex);
+ Tcl_AppendResult(interp, buf, NULL);
+
+ return TCL_OK;
+}
+
#if !(defined(__WIN32__) || defined(MAC_TCL))
/*
*----------------------------------------------------------------------
@@ -1128,8 +2373,13 @@ TestwrapperCmd(clientData, interp, argc, argv)
wrapperPtr = TkpGetWrapperWindow(winPtr);
if (wrapperPtr != NULL) {
- TkpPrintWindowId(interp->result, Tk_WindowId(wrapperPtr));
+ char buf[TCL_INTEGER_SPACE];
+
+ TkpPrintWindowId(buf, Tk_WindowId(wrapperPtr));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
return TCL_OK;
}
#endif
+
+
diff --git a/tk/generic/tkText.c b/tk/generic/tkText.c
index d9ff1cc9165..560c0260d9c 100644
--- a/tk/generic/tkText.c
+++ b/tk/generic/tkText.c
@@ -9,6 +9,7 @@
*
* 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.
@@ -28,6 +29,15 @@
#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:
*/
@@ -112,8 +122,8 @@ static Tk_ConfigSpec configSpecs[] = {
{TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing",
DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3),
TK_CONFIG_DONT_SET_DEFAULT},
- {TK_CONFIG_UID, "-state", "state", "State",
- DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
+ {TK_CONFIG_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",
@@ -121,8 +131,8 @@ static Tk_ConfigSpec configSpecs[] = {
TK_CONFIG_NULL_OK},
{TK_CONFIG_INT, "-width", "width", "Width",
DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
- {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
- DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
+ {TK_CONFIG_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},
@@ -143,21 +153,133 @@ static Tk_ConfigSpec configSpecs[] = {
};
/*
- * Tk_Uid's used to represent text states:
+ * Boolean variable indicating whether or not special debugging code
+ * should be executed.
*/
-Tk_Uid tkTextCharUid = NULL;
-Tk_Uid tkTextDisabledUid = NULL;
-Tk_Uid tkTextNoneUid = NULL;
-Tk_Uid tkTextNormalUid = NULL;
-Tk_Uid tkTextWordUid = NULL;
+int tkTextDebug = 0;
/*
- * Boolean variable indicating whether or not special debugging code
- * should be executed.
+ * Custom options for handling "-wrap":
*/
-int tkTextDebug = 0;
+static int WrapModeParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, 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. */
+ 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:
@@ -189,7 +311,7 @@ static void DumpLine _ANSI_ARGS_((Tcl_Interp *interp,
TkText *textPtr, int what, TkTextLine *linePtr,
int start, int end, int lineno, char *command));
static int DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
- char *value, char * command, int lineno, int offset,
+ char *value, char * command, TkTextIndex *index,
int what));
/*
@@ -241,18 +363,6 @@ Tk_TextCmd(clientData, interp, argc, argv)
}
/*
- * Perform once-only initialization:
- */
-
- if (tkTextNormalUid == NULL) {
- tkTextCharUid = Tk_GetUid("char");
- tkTextDisabledUid = Tk_GetUid("disabled");
- tkTextNoneUid = Tk_GetUid("none");
- tkTextNormalUid = Tk_GetUid("normal");
- tkTextWordUid = Tk_GetUid("word");
- }
-
- /*
* Create the window.
*/
@@ -274,7 +384,7 @@ Tk_TextCmd(clientData, interp, argc, argv)
Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&textPtr->imageTable, TCL_STRING_KEYS);
- textPtr->state = tkTextNormalUid;
+ textPtr->state = TK_STATE_NORMAL;
textPtr->border = NULL;
textPtr->borderWidth = 0;
textPtr->padX = 0;
@@ -293,14 +403,14 @@ Tk_TextCmd(clientData, interp, argc, argv)
textPtr->tabOptionString = NULL;
textPtr->tabsize = 8;
textPtr->tabArrayPtr = NULL;
- textPtr->wrapMode = tkTextCharUid;
+ textPtr->wrapMode = TEXT_WRAPMODE_CHAR;
textPtr->width = 0;
textPtr->height = 0;
textPtr->setGrid = 0;
textPtr->prevWidth = Tk_Width(new);
textPtr->prevHeight = Tk_Height(new);
TkTextCreateDInfo(textPtr);
- TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &startIndex);
TkTextSetYView(textPtr, &startIndex, 0);
textPtr->selTagPtr = NULL;
textPtr->selBorder = NULL;
@@ -336,7 +446,8 @@ Tk_TextCmd(clientData, interp, argc, argv)
*/
textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
- textPtr->selTagPtr->reliefString = (char *) ckalloc(7);
+ 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);
@@ -357,7 +468,7 @@ Tk_TextCmd(clientData, interp, argc, argv)
Tk_DestroyWindow(textPtr->tkwin);
return TCL_ERROR;
}
- interp->result = Tk_PathName(textPtr->tkwin);
+ Tcl_SetResult(interp, Tk_PathName(textPtr->tkwin), TCL_STATIC);
return TCL_OK;
}
@@ -474,7 +585,10 @@ TextWidgetCmd(clientData, interp, argc, argv)
goto done;
}
if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {
- sprintf(interp->result, "%d %d %d %d", x, y, width, height);
+ 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)) {
@@ -532,7 +646,7 @@ TextWidgetCmd(clientData, interp, argc, argv)
} else {
goto compareError;
}
- interp->result = (value) ? "1" : "0";
+ Tcl_SetResult(interp, ((value) ? "1" : "0"), TCL_STATIC);
} else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
&& (length >= 3)) {
if (argc == 2) {
@@ -554,7 +668,7 @@ TextWidgetCmd(clientData, interp, argc, argv)
goto done;
}
if (argc == 2) {
- interp->result = (tkBTreeDebug) ? "1" : "0";
+ Tcl_SetResult(interp, ((tkBTreeDebug) ? "1" : "0"), TCL_STATIC);
} else {
if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
result = TCL_ERROR;
@@ -573,18 +687,7 @@ TextWidgetCmd(clientData, interp, argc, argv)
result = TCL_ERROR;
goto done;
}
- if (textPtr->state == tkTextNormalUid) {
- /*
- * KHAMIS
- * Call synchronize command
- * BEFORE INSERTING INTO THE EDITOR
- ***********************************/
- if (textPtr->SyncCmd && *textPtr->SyncCmd) {
- result = ExecSyncCmd (interp, textPtr, argc, argv);
- if (result == TCL_ERROR) {
- goto done;
- }
- }
+ if (textPtr->state == TK_STATE_NORMAL) {
result = DeleteChars(textPtr, argv[2],
(argc == 4) ? argv[3] : (char *) NULL);
}
@@ -604,8 +707,10 @@ TextWidgetCmd(clientData, interp, argc, argv)
}
if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
== 0) {
- sprintf(interp->result, "%d %d %d %d %d", x, y, width,
- height, base);
+ char buf[TCL_INTEGER_SPACE * 5];
+
+ sprintf(buf, "%d %d %d %d %d", x, y, width, height, base);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
}
} else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
if ((argc != 3) && (argc != 4)) {
@@ -638,10 +743,10 @@ TextWidgetCmd(clientData, interp, argc, argv)
if (index1.linePtr == index2.linePtr) {
int last2;
- if (index2.charIndex == index1.charIndex) {
+ if (index2.byteIndex == index1.byteIndex) {
break;
}
- last2 = index2.charIndex - index1.charIndex + offset;
+ last2 = index2.byteIndex - index1.byteIndex + offset;
if (last2 < last) {
last = last2;
}
@@ -653,10 +758,12 @@ TextWidgetCmd(clientData, interp, argc, argv)
(char *) NULL);
segPtr->body.chars[last] = savedChar;
}
- TkTextIndexForwChars(&index1, last-offset, &index1);
+ TkTextIndexForwBytes(&index1, last-offset, &index1);
}
} else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
&& (length >= 3)) {
+ char buf[200];
+
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " index index\"",
@@ -668,7 +775,8 @@ TextWidgetCmd(clientData, interp, argc, argv)
result = TCL_ERROR;
goto done;
}
- TkTextPrintIndex(&index1, interp->result);
+ 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;
@@ -689,22 +797,11 @@ TextWidgetCmd(clientData, interp, argc, argv)
result = TCL_ERROR;
goto done;
}
- if (textPtr->state == tkTextNormalUid) {
- /*
- * KHAMIS
- * Call synchronize command
- * BEFORE INSERTING INTO THE EDITOR
- ***********************************/
- if (textPtr->SyncCmd && *textPtr->SyncCmd) {
- result = ExecSyncCmd (interp, textPtr, argc, argv);
- if (result == TCL_ERROR) {
- goto done;
- }
- }
+ if (textPtr->state == TK_STATE_NORMAL) {
for (j = 3; j < argc; j += 2) {
InsertChars(textPtr, &index1, argv[j]);
if (argc > (j+1)) {
- TkTextIndexForwChars(&index1, (int) strlen(argv[j]),
+ TkTextIndexForwBytes(&index1, (int) strlen(argv[j]),
&index2);
oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
if (oldTagArrayPtr != NULL) {
@@ -752,8 +849,8 @@ TextWidgetCmd(clientData, interp, argc, argv)
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be bbox, cget, compare, configure, debug, delete, ",
- "dlineinfo, get, image, index, insert, mark, scan, search, see, ",
- "tag, window, xview, or yview",
+ "dlineinfo, dump, get, image, index, insert, mark, scan, ",
+ "search, see, tag, window, xview, or yview",
(char *) NULL);
result = TCL_ERROR;
}
@@ -845,7 +942,7 @@ DestroyText(memPtr)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message.
+ * returned, then the interp's result contains an error message.
*
* Side effects:
* Configuration information, such as text string, colors, font,
@@ -876,23 +973,6 @@ ConfigureText(interp, textPtr, argc, argv, flags)
* the geometry and setting the background from a 3-D border.
*/
- if ((textPtr->state != tkTextNormalUid)
- && (textPtr->state != tkTextDisabledUid)) {
- Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
- "\": must be normal or disabled", (char *) NULL);
- textPtr->state = tkTextNormalUid;
- return TCL_ERROR;
- }
-
- if ((textPtr->wrapMode != tkTextCharUid)
- && (textPtr->wrapMode != tkTextNoneUid)
- && (textPtr->wrapMode != tkTextWordUid)) {
- Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
- "\": must be char, none, or word", (char *) NULL);
- textPtr->wrapMode = tkTextCharUid;
- return TCL_ERROR;
- }
-
Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
/*
@@ -967,7 +1047,8 @@ ConfigureText(interp, textPtr, argc, argv, flags)
|| (textPtr->selTagPtr->spacing3String != NULL)
|| (textPtr->selTagPtr->tabString != NULL)
|| (textPtr->selTagPtr->underlineString != NULL)
- || (textPtr->selTagPtr->wrapMode != NULL)) {
+ || (textPtr->selTagPtr->elideString != NULL)
+ || (textPtr->selTagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
textPtr->selTagPtr->affectsDisplay = 1;
}
TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
@@ -982,8 +1063,8 @@ ConfigureText(interp, textPtr, argc, argv, flags)
TkTextSearch search;
TkTextIndex first, last;
- TkTextMakeIndex(textPtr->tree, 0, 0, &first);
- TkTextMakeIndex(textPtr->tree,
+ 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)
@@ -1214,7 +1295,7 @@ InsertChars(textPtr, indexPtr, string)
lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
lineIndex--;
- TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
}
/*
@@ -1227,16 +1308,16 @@ InsertChars(textPtr, indexPtr, string)
resetView = offset = 0;
if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
resetView = 1;
- offset = textPtr->topIndex.charIndex;
- if (offset > indexPtr->charIndex) {
+ offset = textPtr->topIndex.byteIndex;
+ if (offset > indexPtr->byteIndex) {
offset += strlen(string);
}
}
TkTextChanged(textPtr, indexPtr, indexPtr);
TkBTreeInsertChars(indexPtr, string);
if (resetView) {
- TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop);
- TkTextIndexForwChars(&newTop, offset, &newTop);
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, 0, &newTop);
+ TkTextIndexForwBytes(&newTop, offset, &newTop);
TkTextSetYView(textPtr, &newTop, 0);
}
@@ -1275,7 +1356,7 @@ DeleteChars(textPtr, index1String, index2String)
* delete the one character given by
* index1String. */
{
- int line1, line2, line, charIndex, resetView;
+ int line1, line2, line, byteIndex, resetView;
TkTextIndex index1, index2;
/*
@@ -1326,7 +1407,7 @@ DeleteChars(textPtr, index1String, index2String)
oldIndex2 = index2;
TkTextIndexBackChars(&oldIndex2, 1, &index2);
line2--;
- if ((index1.charIndex == 0) && (line1 != 0)) {
+ if ((index1.byteIndex == 0) && (line1 != 0)) {
TkTextIndexBackChars(&index1, 1, &index1);
line1--;
}
@@ -1349,7 +1430,9 @@ DeleteChars(textPtr, index1String, index2String)
*/
TkTextChanged(textPtr, &index1, &index2);
- resetView = line = charIndex = 0;
+ resetView = 0;
+ line = 0;
+ byteIndex = 0;
if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
/*
@@ -1359,7 +1442,7 @@ DeleteChars(textPtr, index1String, index2String)
resetView = 1;
line = line1;
- charIndex = index1.charIndex;
+ byteIndex = index1.byteIndex;
} else if (index1.linePtr == textPtr->topIndex.linePtr) {
/*
* Deletion range starts on top line but after topIndex.
@@ -1368,7 +1451,7 @@ DeleteChars(textPtr, index1String, index2String)
resetView = 1;
line = line1;
- charIndex = textPtr->topIndex.charIndex;
+ byteIndex = textPtr->topIndex.byteIndex;
}
} else if (index2.linePtr == textPtr->topIndex.linePtr) {
/*
@@ -1379,16 +1462,16 @@ DeleteChars(textPtr, index1String, index2String)
resetView = 1;
line = line2;
- charIndex = textPtr->topIndex.charIndex;
+ byteIndex = textPtr->topIndex.byteIndex;
if (index1.linePtr != index2.linePtr) {
- charIndex -= index2.charIndex;
+ byteIndex -= index2.byteIndex;
} else {
- charIndex -= (index2.charIndex - index1.charIndex);
+ byteIndex -= (index2.byteIndex - index1.byteIndex);
}
}
TkBTreeDeleteChars(&index1, &index2);
if (resetView) {
- TkTextMakeIndex(textPtr->tree, line, charIndex, &index1);
+ TkTextMakeByteIndex(textPtr->tree, line, byteIndex, &index1);
TkTextSetYView(textPtr, &index1, 0);
}
@@ -1452,12 +1535,12 @@ TextFetchSelection(clientData, offset, buffer, maxBytes)
*/
if (offset == 0) {
- TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
textPtr->abortSelections = 0;
} else if (textPtr->abortSelections) {
return 0;
}
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
if (!TkBTreeNextTag(&search)) {
@@ -1504,8 +1587,8 @@ TextFetchSelection(clientData, offset, buffer, maxBytes)
if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
int leftInRange;
- leftInRange = search.curIndex.charIndex
- - textPtr->selIndex.charIndex;
+ leftInRange = search.curIndex.byteIndex
+ - textPtr->selIndex.byteIndex;
if (leftInRange < chunkSize) {
chunkSize = leftInRange;
if (chunkSize <= 0) {
@@ -1513,14 +1596,15 @@ TextFetchSelection(clientData, offset, buffer, maxBytes)
}
}
}
- if (segPtr->typePtr == &tkTextCharType) {
+ 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;
}
- TkTextIndexForwChars(&textPtr->selIndex, chunkSize,
+ TkTextIndexForwBytes(&textPtr->selIndex, chunkSize,
&textPtr->selIndex);
}
@@ -1577,8 +1661,8 @@ TkTextLostSelection(clientData)
* just remove the "sel" tag from everything in the widget.
*/
- TkTextMakeIndex(textPtr->tree, 0, 0, &start);
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
+ 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
@@ -1611,7 +1695,8 @@ TextBlinkProc(clientData)
TkTextIndex index;
int x, y, w, h;
- if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
+ if ((textPtr->state == TK_STATE_DISABLED) ||
+ !(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
return;
}
if (textPtr->flags & INSERT_ON) {
@@ -1654,10 +1739,10 @@ TextSearchCmd(textPtr, interp, argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
- int backwards, exact, c, i, argsLeft, noCase, leftToScan;
+ int backwards, exact, searchElide, c, i, argsLeft, noCase, leftToScan;
size_t length;
- int numLines, startingLine, startingChar, lineNum, firstChar, lastChar;
- int code, matchLength, matchChar, passes, stopLine, searchWholeText;
+ int numLines, startingLine, startingByte, lineNum, firstByte, lastByte;
+ int code, matchLength, matchByte, passes, stopLine, searchWholeText;
int patLength;
char *arg, *pattern, *varName, *p, *startOfLine;
char buffer[20];
@@ -1665,6 +1750,8 @@ TextSearchCmd(textPtr, interp, argc, argv)
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. */
@@ -1673,6 +1760,8 @@ TextSearchCmd(textPtr, interp, argc, argv)
*/
exact = 1;
+ searchElide = 0;
+ curIndex.tree = textPtr->tree;
backwards = 0;
noCase = 0;
varName = NULL;
@@ -1685,8 +1774,8 @@ TextSearchCmd(textPtr, interp, argc, argv)
if (length < 2) {
badSwitch:
Tcl_AppendResult(interp, "bad switch \"", arg,
- "\": must be -forward, -backward, -exact, -regexp, ",
- "-nocase, -count, or --", (char *) NULL);
+ "\": must be --, -backward, -count, -elide, -exact, ",
+ "-forward, -nocase, or -regexp", (char *) NULL);
return TCL_ERROR;
}
c = arg[1];
@@ -1694,13 +1783,24 @@ TextSearchCmd(textPtr, interp, argc, argv)
backwards = 1;
} else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
if (i >= (argc-1)) {
- interp->result = "no value given for \"-count\" option";
+ Tcl_SetResult(interp, "no value given for \"-count\" option",
+ TCL_STATIC);
return TCL_ERROR;
}
i++;
varName = argv[i];
- } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
+ } 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)) {
@@ -1717,7 +1817,7 @@ TextSearchCmd(textPtr, interp, argc, argv)
argsLeft = argc - (i+2);
if ((argsLeft != 0) && (argsLeft != 1)) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " search ?switches? pattern index ?stopIndex?",
+ argv[0], " search ?switches? pattern index ?stopIndex?\"",
(char *) NULL);
return TCL_ERROR;
}
@@ -1727,36 +1827,35 @@ TextSearchCmd(textPtr, interp, argc, argv)
* Convert the pattern to lower-case if we're supposed to ignore case.
*/
- if (noCase) {
+ if (noCase && exact) {
Tcl_DStringInit(&patDString);
Tcl_DStringAppend(&patDString, pattern, -1);
pattern = Tcl_DStringValue(&patDString);
- for (p = pattern; *p != 0; p++) {
- if (isupper(UCHAR(*p))) {
- *p = tolower(UCHAR(*p));
- }
- }
+ Tcl_UtfToLower(pattern);
}
+ Tcl_DStringInit(&line);
if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
numLines = TkBTreeNumLines(textPtr->tree);
startingLine = TkBTreeLineIndex(index.linePtr);
- startingChar = index.charIndex;
+ startingByte = index.byteIndex;
if (startingLine >= numLines) {
if (backwards) {
startingLine = TkBTreeNumLines(textPtr->tree) - 1;
- startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree,
+ startingByte = TkBTreeBytesInLine(TkBTreeFindLine(textPtr->tree,
startingLine));
} else {
startingLine = 0;
- startingChar = 0;
+ startingByte = 0;
}
}
if (argsLeft == 1) {
if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
stopLine = TkBTreeLineIndex(stopIndex.linePtr);
if (!backwards && (stopLine == numLines)) {
@@ -1778,14 +1877,17 @@ TextSearchCmd(textPtr, interp, argc, argv)
if (exact) {
patLength = strlen(pattern);
} else {
- regexp = Tcl_RegExpCompile(interp, pattern);
+ patObj = Tcl_NewStringObj(pattern, -1);
+ Tcl_IncrRefCount(patObj);
+ regexp = Tcl_GetRegExpFromObj(interp, patObj,
+ (noCase ? TCL_REG_NOCASE : 0) | TCL_REG_ADVANCED);
if (regexp == NULL) {
- return TCL_ERROR;
+ code = TCL_ERROR;
+ goto done;
}
}
lineNum = startingLine;
code = TCL_OK;
- Tcl_DStringInit(&line);
for (passes = 0; passes < 2; ) {
if (lineNum >= numLines) {
/*
@@ -1802,9 +1904,11 @@ TextSearchCmd(textPtr, interp, argc, argv)
*/
linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ curIndex.linePtr = linePtr; curIndex.byteIndex = 0;
for (segPtr = linePtr->segPtr; segPtr != NULL;
- segPtr = segPtr->nextPtr) {
- if (segPtr->typePtr != &tkTextCharType) {
+ curIndex.byteIndex += segPtr->size, segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr != &tkTextCharType)
+ || (!searchElide && TkTextIsElided(textPtr, &curIndex))) {
continue;
}
Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
@@ -1819,22 +1923,20 @@ TextSearchCmd(textPtr, interp, argc, argv)
*/
if (noCase) {
- for (p = Tcl_DStringValue(&line); *p != 0; p++) {
- if (isupper(UCHAR(*p))) {
- *p = tolower(UCHAR(*p));
- }
- }
+ 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.
+ * in the line. (Note: The lastByte should include the NULL char
+ * so we can handle searching for end of line easier.)
*/
- matchChar = -1;
- firstChar = 0;
- lastChar = INT_MAX;
+ matchByte = -1;
+ firstByte = 0;
+ lastByte = Tcl_DStringLength(&line) + 1;
if (lineNum == startingLine) {
int indexInDString;
@@ -1848,8 +1950,8 @@ TextSearchCmd(textPtr, interp, argc, argv)
* character.
*/
- indexInDString = startingChar;
- for (segPtr = linePtr->segPtr, leftToScan = startingChar;
+ indexInDString = startingByte;
+ for (segPtr = linePtr->segPtr, leftToScan = startingByte;
leftToScan > 0; segPtr = segPtr->nextPtr) {
if (segPtr->typePtr != &tkTextCharType) {
indexInDString -= segPtr->size;
@@ -1863,8 +1965,9 @@ TextSearchCmd(textPtr, interp, argc, argv)
* Only use the last part of the line.
*/
- firstChar = indexInDString;
- if (firstChar >= Tcl_DStringLength(&line)) {
+ firstByte = indexInDString;
+ if ((firstByte >= Tcl_DStringLength(&line))
+ && !((Tcl_DStringLength(&line) == 0) && !exact)) {
goto nextLine;
}
} else {
@@ -1872,13 +1975,16 @@ TextSearchCmd(textPtr, interp, argc, argv)
* Use only the first part of the line.
*/
- lastChar = indexInDString;
+ lastByte = indexInDString;
}
}
do {
int thisLength;
+ Tcl_UniChar ch;
+
if (exact) {
- p = strstr(startOfLine + firstChar, pattern);
+ p = strstr(startOfLine + firstByte, /* INTL: Native. */
+ pattern);
if (p == NULL) {
break;
}
@@ -1889,7 +1995,7 @@ TextSearchCmd(textPtr, interp, argc, argv)
int match;
match = Tcl_RegExpExec(interp, regexp,
- startOfLine + firstChar, startOfLine);
+ startOfLine + firstByte, startOfLine);
if (match < 0) {
code = TCL_ERROR;
goto done;
@@ -1901,12 +2007,12 @@ TextSearchCmd(textPtr, interp, argc, argv)
i = start - startOfLine;
thisLength = end - start;
}
- if (i >= lastChar) {
+ if (i >= lastByte) {
break;
}
- matchChar = i;
+ matchByte = i;
matchLength = thisLength;
- firstChar = matchChar+1;
+ firstByte = i + Tcl_UtfToUniChar(startOfLine + matchByte, &ch);
} while (backwards);
/*
@@ -1915,32 +2021,49 @@ TextSearchCmd(textPtr, interp, argc, argv)
* specified.
*/
- if (matchChar >= 0) {
+ if (matchByte >= 0) {
+ int numChars;
+
+ /*
+ * Convert the byte length to a character count.
+ */
+
+ numChars = Tcl_NumUtfChars(startOfLine + matchByte,
+ matchLength);
+
/*
* The index information returned by the regular expression
* parser only considers textual information: it doesn't
- * account for embedded windows or any other non-textual info.
+ * 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.
*/
- for (segPtr = linePtr->segPtr, leftToScan = matchChar;
- leftToScan >= 0; segPtr = segPtr->nextPtr) {
- if (segPtr->typePtr != &tkTextCharType) {
- matchChar += segPtr->size;
- continue;
+ 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;
}
- leftToScan -= segPtr->size;
+ curIndex.byteIndex += segPtr->size;
}
for (leftToScan += matchLength; leftToScan > 0;
segPtr = segPtr->nextPtr) {
if (segPtr->typePtr != &tkTextCharType) {
- matchLength += segPtr->size;
+ numChars += segPtr->size;
continue;
}
leftToScan -= segPtr->size;
}
- TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index);
+ TkTextMakeByteIndex(textPtr->tree, lineNum, matchByte, &index);
if (!searchWholeText) {
if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
goto done;
@@ -1950,14 +2073,15 @@ TextSearchCmd(textPtr, interp, argc, argv)
}
}
if (varName != NULL) {
- sprintf(buffer, "%d", matchLength);
+ sprintf(buffer, "%d", numChars);
if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
== NULL) {
code = TCL_ERROR;
goto done;
}
}
- TkTextPrintIndex(&index, interp->result);
+ TkTextPrintIndex(&index, buffer);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
goto done;
}
@@ -1989,9 +2113,12 @@ TextSearchCmd(textPtr, interp, argc, argv)
}
done:
Tcl_DStringFree(&line);
- if (noCase) {
+ if (noCase && exact) {
Tcl_DStringFree(&patDString);
}
+ if (patObj != NULL) {
+ Tcl_DecrRefCount(patObj);
+ }
return code;
}
@@ -2006,7 +2133,7 @@ TextSearchCmd(textPtr, interp, argc, argv)
* The return value is a pointer to a malloc'ed structure holding
* parsed information about the tab stops. If an error occurred
* then the return value is NULL and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* Memory is allocated for the structure that is returned. It is
@@ -2028,6 +2155,7 @@ TkTextGetTabs(interp, tkwin, string)
char **argv;
TkTextTabArray *tabArrayPtr;
TkTextTab *tabPtr;
+ Tcl_UniChar ch;
if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
return NULL;
@@ -2070,11 +2198,12 @@ TkTextGetTabs(interp, tkwin, string)
if ((i+1) == argc) {
continue;
}
- c = UCHAR(argv[i+1][0]);
- if (!isalpha(c)) {
+ 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;
@@ -2186,7 +2315,7 @@ TextDumpCmd(textPtr, interp, argc, argv)
if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) {
return TCL_ERROR;
}
- lineno = TkBTreeLineIndex(index1.linePtr) + 1;
+ lineno = TkBTreeLineIndex(index1.linePtr);
arg++;
atEnd = 0;
if (argc == arg) {
@@ -2204,10 +2333,10 @@ TextDumpCmd(textPtr, interp, argc, argv)
}
if (index1.linePtr == index2.linePtr) {
DumpLine(interp, textPtr, what, index1.linePtr,
- index1.charIndex, index2.charIndex, lineno, command);
+ index1.byteIndex, index2.byteIndex, lineno, command);
} else {
DumpLine(interp, textPtr, what, index1.linePtr,
- index1.charIndex, 32000000, lineno, command);
+ index1.byteIndex, 32000000, lineno, command);
linePtr = index1.linePtr;
while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
lineno++;
@@ -2218,14 +2347,14 @@ TextDumpCmd(textPtr, interp, argc, argv)
lineno, command);
}
DumpLine(interp, textPtr, what, index2.linePtr, 0,
- index2.charIndex, lineno, command);
+ 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);
+ 0, 1, lineno, command);
}
return TCL_OK;
@@ -2243,17 +2372,18 @@ TextDumpCmd(textPtr, interp, argc, argv)
* None, but see DumpSegment.
*/
static void
-DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
+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 start, end; /* Character range to dump */
+ int startByte, endByte; /* Byte range to dump */
int lineno; /* Line number for indices dump */
char *command; /* Script to apply to the segment */
{
int offset;
TkTextSegment *segPtr;
+ TkTextIndex index;
/*
* Must loop through line looking at its segments.
* character
@@ -2262,47 +2392,54 @@ DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
* image
* window
*/
+
for (offset = 0, segPtr = linePtr->segPtr ;
- (offset < end) && (segPtr != (TkTextSegment *)NULL) ;
+ (offset < endByte) && (segPtr != (TkTextSegment *)NULL) ;
offset += segPtr->size, segPtr = segPtr->nextPtr) {
if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
- (offset + segPtr->size > start)) {
+ (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 > end) {
- last = end - offset;
+ if (offset + segPtr->size > endByte) {
+ last = endByte - offset;
}
- if (start > offset) {
- first = start - 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, lineno, offset + first, what);
+ command, &index, what);
segPtr->body.chars[last] = savedChar;
- } else if ((offset >= start)) {
+ } else if ((offset >= startByte)) {
if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
- DumpSegment(interp, "mark", name,
- command, lineno, offset, what);
+
+ 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, lineno, offset, what);
+ 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, lineno, offset, what);
+ 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, lineno, offset, what);
+ command, &index, what);
} else if ((what & TK_DUMP_WIN) &&
(segPtr->typePtr->name[0] == 'w')) {
TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body;
@@ -2312,8 +2449,9 @@ DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
} else {
pathname = Tk_PathName(ewPtr->tkwin);
}
+ TkTextMakeByteIndex(textPtr->tree, lineno, offset, &index);
DumpSegment(interp, "window", pathname,
- command, lineno, offset, what);
+ command, &index, what);
}
}
}
@@ -2331,17 +2469,16 @@ DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
* Either evals the callback or appends elements to the result string.
*/
static int
-DumpSegment(interp, key, value, command, lineno, offset, what)
+DumpSegment(interp, key, value, command, index, what)
Tcl_Interp *interp;
char *key; /* Segment type key */
char *value; /* Segment value */
char *command; /* Script callback */
- int lineno; /* Line number for indices dump */
- int offset; /* Character position */
+ TkTextIndex *index; /* index with line/byte position info */
int what; /* Look for TK_DUMP_INDEX bit */
{
- char buffer[30];
- sprintf(buffer, "%d.%d", lineno, offset);
+ char buffer[TCL_INTEGER_SPACE*2];
+ TkTextPrintIndex(index, buffer);
if (command == (char *) NULL) {
Tcl_AppendElement(interp, key);
Tcl_AppendElement(interp, value);
@@ -2362,3 +2499,5 @@ DumpSegment(interp, key, value, command, lineno, offset, what)
}
}
+
+
diff --git a/tk/generic/tkText.h b/tk/generic/tkText.h
index e8c0ab2440e..9152e2c7264 100644
--- a/tk/generic/tkText.h
+++ b/tk/generic/tkText.h
@@ -20,6 +20,11 @@
#include "tk.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:
@@ -176,7 +181,7 @@ typedef struct TkTextIndex {
TkTextBTree tree; /* Tree containing desired position. */
TkTextLine *linePtr; /* Pointer to line containing position
* of interest. */
- int charIndex; /* Index within line of desired
+ int byteIndex; /* Index within line of desired
* character (0 means first one). */
} TkTextIndex;
@@ -241,7 +246,7 @@ struct TkTextDispChunk {
* a given x-location. */
Tk_ChunkBboxProc *bboxProc; /* Procedure to find bounding box
* of character in chunk. */
- int numChars; /* Number of characters that will be
+ int numBytes; /* Number of bytes that will be
* displayed in the chunk. */
int minAscent; /* Minimum space above the baseline
* needed by this chunk. */
@@ -256,7 +261,7 @@ struct TkTextDispChunk {
* of line. */
int breakIndex; /* Index within chunk of last
* acceptable position for a line
- * (break just before this character).
+ * (break just before this byte index).
* <= 0 means don't break during or
* immediately after this chunk. */
ClientData clientData; /* Additional information for use
@@ -269,6 +274,12 @@ struct TkTextDispChunk {
* 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
@@ -366,10 +377,15 @@ typedef struct TkTextTag {
int underline; /* Non-zero means draw underline underneath
* text. Only valid if underlineString is
* non-NULL. */
- Tk_Uid wrapMode; /* How to handle wrap-around for this tag.
- * Must be tkTextCharUid, tkTextNoneUid,
- * tkTextWordUid, or NULL to use wrapMode
- * for whole widget. */
+ 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). */
@@ -470,8 +486,8 @@ typedef struct TkText {
* image segment doesn't yet have an
* associated image, there is no entry for
* it here. */
- Tk_Uid state; /* Normal or disabled. Text is read-only
- * when disabled. */
+ 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
@@ -518,9 +534,9 @@ typedef struct TkText {
* Additional information used for displaying:
*/
- Tk_Uid wrapMode; /* How to handle wrap-around. Must be
- * tkTextCharUid, tkTextNoneUid, or
- * tkTextWordUid. */
+ 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
@@ -661,7 +677,7 @@ typedef void Tk_SegLineChangeProc _ANSI_ARGS_((
typedef int Tk_SegLayoutProc _ANSI_ARGS_((struct TkText *textPtr,
struct TkTextIndex *indexPtr, TkTextSegment *segPtr,
int offset, int maxX, int maxChars,
- int noCharsYet, Tk_Uid wrapMode,
+ int noCharsYet, TkWrapMode wrapMode,
struct TkTextDispChunk *chunkPtr));
typedef void Tk_SegCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
TkTextLine *linePtr));
@@ -717,141 +733,156 @@ typedef struct Tk_SegType {
* Declarations for variables shared among the text-related files:
*/
-extern int tkBTreeDebug;
-extern int tkTextDebug;
-extern Tk_SegType tkTextCharType;
-extern Tk_Uid tkTextCharUid;
-extern Tk_Uid tkTextDisabledUid;
-extern Tk_SegType tkTextLeftMarkType;
-extern Tk_Uid tkTextNoneUid;
-extern Tk_Uid tkTextNormalUid;
-extern Tk_SegType tkTextRightMarkType;
-extern Tk_SegType tkTextToggleOnType;
-extern Tk_SegType tkTextToggleOffType;
-extern Tk_Uid tkTextWordUid;
+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,
+EXTERN int TkBTreeCharTagged _ANSI_ARGS_((TkTextIndex *indexPtr,
TkTextTag *tagPtr));
-extern void TkBTreeCheck _ANSI_ARGS_((TkTextBTree tree));
-extern int TkBTreeCharsInLine _ANSI_ARGS_((TkTextLine *linePtr));
-extern TkTextBTree TkBTreeCreate _ANSI_ARGS_((TkText *textPtr));
-extern void TkBTreeDestroy _ANSI_ARGS_((TkTextBTree tree));
-extern void TkBTreeDeleteChars _ANSI_ARGS_((TkTextIndex *index1Ptr,
+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,
+EXTERN TkTextLine * TkBTreeFindLine _ANSI_ARGS_((TkTextBTree tree,
int line));
-extern TkTextTag ** TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr,
+EXTERN TkTextTag ** TkBTreeGetTags _ANSI_ARGS_((TkTextIndex *indexPtr,
int *numTagsPtr));
-extern void TkBTreeInsertChars _ANSI_ARGS_((TkTextIndex *indexPtr,
+EXTERN void TkBTreeInsertChars _ANSI_ARGS_((TkTextIndex *indexPtr,
char *string));
-extern int TkBTreeLineIndex _ANSI_ARGS_((TkTextLine *linePtr));
-extern void TkBTreeLinkSegment _ANSI_ARGS_((TkTextSegment *segPtr,
+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,
+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,
+EXTERN void TkBTreeStartSearchBack _ANSI_ARGS_((TkTextIndex *index1Ptr,
TkTextIndex *index2Ptr, TkTextTag *tagPtr,
TkTextSearch *searchPtr));
-extern void TkBTreeTag _ANSI_ARGS_((TkTextIndex *index1Ptr,
+EXTERN void TkBTreeTag _ANSI_ARGS_((TkTextIndex *index1Ptr,
TkTextIndex *index2Ptr, TkTextTag *tagPtr,
int add));
-extern void TkBTreeUnlinkSegment _ANSI_ARGS_((TkTextBTree tree,
+EXTERN void TkBTreeUnlinkSegment _ANSI_ARGS_((TkTextBTree tree,
TkTextSegment *segPtr, TkTextLine *linePtr));
-extern void TkTextBindProc _ANSI_ARGS_((ClientData clientData,
+EXTERN void TkTextBindProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
-extern void TkTextChanged _ANSI_ARGS_((TkText *textPtr,
+EXTERN void TkTextChanged _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *index1Ptr, TkTextIndex *index2Ptr));
-extern int TkTextCharBbox _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextCharBbox _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr, int *xPtr, int *yPtr,
int *widthPtr, int *heightPtr));
-extern int TkTextCharLayoutProc _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextCharLayoutProc _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr, TkTextSegment *segPtr,
int offset, int maxX, int maxChars, int noBreakYet,
- Tk_Uid wrapMode, TkTextDispChunk *chunkPtr));
-extern void TkTextCreateDInfo _ANSI_ARGS_((TkText *textPtr));
-extern int TkTextDLineInfo _ANSI_ARGS_((TkText *textPtr,
+ 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,
+EXTERN TkTextTag * TkTextCreateTag _ANSI_ARGS_((TkText *textPtr,
char *tagName));
-extern void TkTextFreeDInfo _ANSI_ARGS_((TkText *textPtr));
-extern void TkTextFreeTag _ANSI_ARGS_((TkText *textPtr,
+EXTERN void TkTextFreeDInfo _ANSI_ARGS_((TkText *textPtr));
+EXTERN void TkTextFreeTag _ANSI_ARGS_((TkText *textPtr,
TkTextTag *tagPtr));
-extern int TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN int TkTextGetIndex _ANSI_ARGS_((Tcl_Interp *interp,
TkText *textPtr, char *string,
TkTextIndex *indexPtr));
-extern TkTextTabArray * TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN TkTextTabArray * TkTextGetTabs _ANSI_ARGS_((Tcl_Interp *interp,
Tk_Window tkwin, char *string));
-extern void TkTextIndexBackChars _ANSI_ARGS_((TkTextIndex *srcPtr,
- int count, TkTextIndex *dstPtr));
-extern int TkTextIndexCmp _ANSI_ARGS_((TkTextIndex *index1Ptr,
- TkTextIndex *index2Ptr));
-extern void TkTextIndexForwChars _ANSI_ARGS_((TkTextIndex *srcPtr,
- int count, TkTextIndex *dstPtr));
-extern TkTextSegment * TkTextIndexToSeg _ANSI_ARGS_((TkTextIndex *indexPtr,
- int *offsetPtr));
-extern void TkTextInsertDisplayProc _ANSI_ARGS_((
+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_((
+EXTERN void TkTextLostSelection _ANSI_ARGS_((
ClientData clientData));
-extern TkTextIndex * TkTextMakeIndex _ANSI_ARGS_((TkTextBTree tree,
+EXTERN TkTextIndex * TkTextMakeCharIndex _ANSI_ARGS_((TkTextBTree tree,
int lineIndex, int charIndex,
TkTextIndex *indexPtr));
-extern int TkTextMarkCmd _ANSI_ARGS_((TkText *textPtr,
+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, char **argv));
-extern int TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextMarkNameToIndex _ANSI_ARGS_((TkText *textPtr,
char *name, TkTextIndex *indexPtr));
-extern void TkTextMarkSegToIndex _ANSI_ARGS_((TkText *textPtr,
+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,
+EXTERN void TkTextEventuallyRepick _ANSI_ARGS_((TkText *textPtr));
+EXTERN void TkTextPickCurrent _ANSI_ARGS_((TkText *textPtr,
XEvent *eventPtr));
-extern void TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr,
+EXTERN void TkTextPixelIndex _ANSI_ARGS_((TkText *textPtr,
int x, int y, TkTextIndex *indexPtr));
-extern void TkTextPrintIndex _ANSI_ARGS_((TkTextIndex *indexPtr,
- char *string));
-extern void TkTextRedrawRegion _ANSI_ARGS_((TkText *textPtr,
+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,
+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,
+EXTERN void TkTextRelayoutWindow _ANSI_ARGS_((TkText *textPtr));
+EXTERN int TkTextScanCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
-extern int TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextSeeCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
-extern int TkTextSegToOffset _ANSI_ARGS_((TkTextSegment *segPtr,
- TkTextLine *linePtr));
-extern TkTextSegment * TkTextSetMark _ANSI_ARGS_((TkText *textPtr, char *name,
+EXTERN int TkTextSegToOffset _ANSI_ARGS_((
+ CONST TkTextSegment *segPtr,
+ CONST TkTextLine *linePtr));
+EXTERN TkTextSegment * TkTextSetMark _ANSI_ARGS_((TkText *textPtr, char *name,
TkTextIndex *indexPtr));
-extern void TkTextSetYView _ANSI_ARGS_((TkText *textPtr,
+EXTERN void TkTextSetYView _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr, int pickPlace));
-extern int TkTextTagCmd _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextTagCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
-extern int TkTextImageCmd _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextImageCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
-extern int TkTextImageIndex _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextImageIndex _ANSI_ARGS_((TkText *textPtr,
char *name, TkTextIndex *indexPtr));
-extern int TkTextWindowCmd _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextWindowCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
-extern int TkTextWindowIndex _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextWindowIndex _ANSI_ARGS_((TkText *textPtr,
char *name, TkTextIndex *indexPtr));
-extern int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
-extern int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr,
+EXTERN int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr,
Tcl_Interp *interp, int argc, char **argv));
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
#endif /* _TKTEXT */
+
diff --git a/tk/generic/tkTextBTree.c b/tk/generic/tkTextBTree.c
index 128edd29550..42fa1b2cba4 100644
--- a/tk/generic/tkTextBTree.c
+++ b/tk/generic/tkTextBTree.c
@@ -535,7 +535,7 @@ SplitSeg(indexPtr)
TkTextSegment *prevPtr, *segPtr;
int count;
- for (count = indexPtr->charIndex, prevPtr = NULL,
+ for (count = indexPtr->byteIndex, prevPtr = NULL,
segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
count -= segPtr->size, prevPtr = segPtr, segPtr = segPtr->nextPtr) {
if (segPtr->size > count) {
@@ -1530,7 +1530,7 @@ FindTagStart(tree, tagPtr, indexPtr)
*/
indexPtr->tree = tree;
indexPtr->linePtr = linePtr;
- indexPtr->charIndex = offset;
+ indexPtr->byteIndex = offset;
return segPtr;
}
}
@@ -1619,7 +1619,7 @@ FindTagEnd(tree, tagPtr, indexPtr)
}
indexPtr->tree = tree;
indexPtr->linePtr = lastLinePtr;
- indexPtr->charIndex = lastoffset2;
+ indexPtr->byteIndex = lastoffset2;
return last2SegPtr;
}
@@ -1694,7 +1694,7 @@ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr)
searchPtr->curIndex = *index1Ptr;
searchPtr->segPtr = NULL;
searchPtr->nextPtr = TkTextIndexToSeg(index1Ptr, &offset);
- searchPtr->curIndex.charIndex -= offset;
+ searchPtr->curIndex.byteIndex -= offset;
}
searchPtr->lastPtr = TkTextIndexToSeg(index2Ptr, (int *) NULL);
searchPtr->tagPtr = tagPtr;
@@ -1709,9 +1709,9 @@ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr)
* the range, unless the range is artificially moved up to index0.
*/
if (((index1Ptr == &index0) &&
- (index1Ptr->charIndex > index2Ptr->charIndex)) ||
+ (index1Ptr->byteIndex > index2Ptr->byteIndex)) ||
((index1Ptr != &index0) &&
- (index1Ptr->charIndex >= index2Ptr->charIndex))) {
+ (index1Ptr->byteIndex >= index2Ptr->byteIndex))) {
searchPtr->linesLeft = 0;
}
}
@@ -1793,7 +1793,7 @@ TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr)
}
searchPtr->segPtr = NULL;
searchPtr->nextPtr = TkTextIndexToSeg(&searchPtr->curIndex, &offset);
- searchPtr->curIndex.charIndex -= offset;
+ searchPtr->curIndex.byteIndex -= offset;
/*
* Adjust the end of the search so it does find toggles that are right
@@ -1801,7 +1801,7 @@ TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr)
*/
if ((TkBTreeLineIndex(index2Ptr->linePtr) == 0) &&
- (index2Ptr->charIndex == 0)) {
+ (index2Ptr->byteIndex == 0)) {
backOne = *index2Ptr;
searchPtr->lastPtr = NULL; /* Signals special case for 1.0 */
} else {
@@ -1819,7 +1819,7 @@ TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr)
* first.
*/
- if (index1Ptr->charIndex <= backOne.charIndex) {
+ if (index1Ptr->byteIndex <= backOne.byteIndex) {
searchPtr->linesLeft = 0;
}
}
@@ -1889,7 +1889,7 @@ TkBTreeNextTag(searchPtr)
searchPtr->tagPtr = segPtr->body.toggle.tagPtr;
return 1;
}
- searchPtr->curIndex.charIndex += segPtr->size;
+ searchPtr->curIndex.byteIndex += segPtr->size;
}
/*
@@ -1906,7 +1906,7 @@ TkBTreeNextTag(searchPtr)
}
if (searchPtr->curIndex.linePtr != NULL) {
segPtr = searchPtr->curIndex.linePtr->segPtr;
- searchPtr->curIndex.charIndex = 0;
+ searchPtr->curIndex.byteIndex = 0;
continue;
}
if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
@@ -1972,7 +1972,7 @@ TkBTreeNextTag(searchPtr)
*/
searchPtr->curIndex.linePtr = nodePtr->children.linePtr;
- searchPtr->curIndex.charIndex = 0;
+ searchPtr->curIndex.byteIndex = 0;
segPtr = searchPtr->curIndex.linePtr->segPtr;
if (searchPtr->linesLeft <= 0) {
goto searchOver;
@@ -2022,7 +2022,7 @@ TkBTreePrevTag(searchPtr)
register TkTextLine *linePtr, *prevLinePtr;
register Node *nodePtr, *node2Ptr, *prevNodePtr;
register Summary *summaryPtr;
- int charIndex;
+ int byteIndex;
int pastLast; /* Saw last marker during scan */
int linesSkipped;
@@ -2041,7 +2041,7 @@ TkBTreePrevTag(searchPtr)
/*
* Check for the last toggle before the current segment on this line.
*/
- charIndex = 0;
+ byteIndex = 0;
if (searchPtr->lastPtr == NULL) {
/*
* Search back to the very beginning, so pastLast is irrelevent.
@@ -2058,13 +2058,13 @@ TkBTreePrevTag(searchPtr)
&& (searchPtr->allTags
|| (segPtr->body.toggle.tagPtr == searchPtr->tagPtr))) {
prevPtr = segPtr;
- searchPtr->curIndex.charIndex = charIndex;
+ searchPtr->curIndex.byteIndex = byteIndex;
}
if (segPtr == searchPtr->lastPtr) {
prevPtr = NULL; /* Segments earlier than last don't count */
pastLast = 1;
}
- charIndex += segPtr->size;
+ byteIndex += segPtr->size;
}
if (prevPtr != NULL) {
if (searchPtr->linesLeft == 1 && !pastLast) {
@@ -2191,7 +2191,7 @@ TkBTreePrevTag(searchPtr)
/* empty loop body */ ;
}
searchPtr->curIndex.linePtr = prevLinePtr;
- searchPtr->curIndex.charIndex = 0;
+ searchPtr->curIndex.byteIndex = 0;
if (searchPtr->linesLeft <= 0) {
goto searchOver;
}
@@ -2241,7 +2241,7 @@ TkBTreeCharTagged(indexPtr, tagPtr)
toggleSegPtr = NULL;
for (index = 0, segPtr = indexPtr->linePtr->segPtr;
- (index + segPtr->size) <= indexPtr->charIndex;
+ (index + segPtr->size) <= indexPtr->byteIndex;
index += segPtr->size, segPtr = segPtr->nextPtr) {
if (((segPtr->typePtr == &tkTextToggleOnType)
|| (segPtr->typePtr == &tkTextToggleOffType))
@@ -2360,7 +2360,7 @@ TkBTreeGetTags(indexPtr, numTagsPtr)
*/
for (index = 0, segPtr = indexPtr->linePtr->segPtr;
- (index + segPtr->size) <= indexPtr->charIndex;
+ (index + segPtr->size) <= indexPtr->byteIndex;
index += segPtr->size, segPtr = segPtr->nextPtr) {
if ((segPtr->typePtr == &tkTextToggleOnType)
|| (segPtr->typePtr == &tkTextToggleOffType)) {
@@ -2431,6 +2431,148 @@ TkBTreeGetTags(indexPtr, numTagsPtr)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -3588,7 +3730,27 @@ TkBTreeCharsInLine(linePtr)
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/tk/generic/tkTextDisp.c b/tk/generic/tkTextDisp.c
index 9d0afc19727..36906b8caba 100644
--- a/tk/generic/tkTextDisp.c
+++ b/tk/generic/tkTextDisp.c
@@ -18,6 +18,10 @@
#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
@@ -55,9 +59,10 @@ typedef struct StyleValues {
* be NULL). */
int underline; /* Non-zero means draw underline underneath
* text. */
- Tk_Uid wrapMode; /* How to handle wrap-around for this tag.
- * One of tkTextCharUid, tkTextNoneUid,
- * or tkTextWordUid. */
+ 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;
/*
@@ -98,7 +103,7 @@ typedef struct TextStyle {
typedef struct DLine {
TkTextIndex index; /* Identifies first character in text
* that is displayed on this line. */
- int count; /* Number of characters accounted for by this
+ 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
@@ -156,12 +161,14 @@ typedef struct DLine {
* 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:
@@ -199,7 +206,7 @@ typedef struct TextDInfo {
* Information used for scrolling:
*/
- int newCharOffset; /* Desired x scroll position, measured as the
+ 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. */
@@ -222,8 +229,9 @@ typedef struct TextDInfo {
* The following information is used to implement scanning:
*/
- int scanMarkChar; /* Character that was at the left edge of
- * the window when the scan started. */
+ int 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. */
@@ -254,9 +262,9 @@ typedef struct TextDInfo {
*/
typedef struct CharInfo {
- int numChars; /* Number of characters to display. */
- char chars[4]; /* Characters to display. Actual size
- * will be numChars, not 4. THIS MUST BE
+ 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;
@@ -311,6 +319,21 @@ 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,
@@ -331,7 +354,7 @@ static void GetYView _ANSI_ARGS_((Tcl_Interp *interp,
static DLine * LayoutDLine _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr));
static int MeasureChars _ANSI_ARGS_((Tk_Font tkfont,
- CONST char *source, int maxChars, int startX,
+ CONST char *source, int maxBytes, int startX,
int maxX, int tabOrigin, int *nextXPtr));
static void MeasureUp _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *srcPtr, int distance,
@@ -381,14 +404,14 @@ TkTextCreateDInfo(textPtr)
dInfoPtr->scrollGC = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures,
&gcValues);
dInfoPtr->topOfEof = 0;
- dInfoPtr->newCharOffset = 0;
+ dInfoPtr->newByteOffset = 0;
dInfoPtr->curPixelOffset = 0;
dInfoPtr->maxLength = 0;
dInfoPtr->xScrollFirst = -1;
dInfoPtr->xScrollLast = -1;
dInfoPtr->yScrollFirst = -1;
dInfoPtr->yScrollLast = -1;
- dInfoPtr->scanMarkChar = 0;
+ dInfoPtr->scanMarkIndex = 0;
dInfoPtr->scanMarkX = 0;
dInfoPtr->scanTotalScroll = 0;
dInfoPtr->scanMarkY = 0;
@@ -479,7 +502,7 @@ GetStyle(textPtr, indexPtr)
int borderPrio, borderWidthPrio, reliefPrio, bgStipplePrio;
int fgPrio, fontPrio, fgStipplePrio;
- int underlinePrio, justifyPrio, offsetPrio;
+ int underlinePrio, elidePrio, justifyPrio, offsetPrio;
int lMargin1Prio, lMargin2Prio, rMarginPrio;
int spacing1Prio, spacing2Prio, spacing3Prio;
int overstrikePrio, tabPrio, wrapPrio;
@@ -494,7 +517,7 @@ GetStyle(textPtr, indexPtr)
tagPtrs = TkBTreeGetTags(indexPtr, &numTags);
borderPrio = borderWidthPrio = reliefPrio = bgStipplePrio = -1;
fgPrio = fontPrio = fgStipplePrio = -1;
- underlinePrio = justifyPrio = offsetPrio = -1;
+ underlinePrio = elidePrio = justifyPrio = offsetPrio = -1;
lMargin1Prio = lMargin2Prio = rMarginPrio = -1;
spacing1Prio = spacing2Prio = spacing3Prio = -1;
overstrikePrio = tabPrio = wrapPrio = -1;
@@ -508,6 +531,7 @@ GetStyle(textPtr, indexPtr)
styleValues.spacing3 = textPtr->spacing3;
styleValues.tabArrayPtr = textPtr->tabArrayPtr;
styleValues.wrapMode = textPtr->wrapMode;
+ styleValues.elide = 0;
for (i = 0 ; i < numTags; i++) {
tagPtr = tagPtrs[i];
@@ -612,7 +636,12 @@ GetStyle(textPtr, indexPtr)
styleValues.underline = tagPtr->underline;
underlinePrio = tagPtr->priority;
}
- if ((tagPtr->wrapMode != NULL)
+ 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;
@@ -648,22 +677,20 @@ GetStyle(textPtr, indexPtr)
gcValues.fill_style = FillStippled;
mask |= GCStipple|GCFillStyle;
}
- stylePtr->bgGC = Tk_GetGCColor(textPtr->tkwin, mask, &gcValues,
- Tk_3DBorderColor(styleValues.border),
- NULL);
+ stylePtr->bgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
} else {
stylePtr->bgGC = None;
}
- mask = GCForeground|GCFont;
- gcValues.foreground = styleValues.fgColor->pixel;
+ 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_GetGCColor(textPtr->tkwin, mask, &gcValues,
- styleValues.fgColor, NULL);
+ stylePtr->fgGC = Tk_GetGC(textPtr->tkwin, mask, &gcValues);
stylePtr->sValuePtr = (StyleValues *)
Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr);
stylePtr->hPtr = hPtr;
@@ -701,7 +728,9 @@ FreeStyle(textPtr, stylePtr)
if (stylePtr->bgGC != None) {
Tk_FreeGC(textPtr->display, stylePtr->bgGC);
}
- Tk_FreeGC(textPtr->display, stylePtr->fgGC);
+ if (stylePtr->fgGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->fgGC);
+ }
Tcl_DeleteHashEntry(stylePtr->hPtr);
ckfree((char *) stylePtr);
}
@@ -742,16 +771,18 @@ LayoutDLine(textPtr, indexPtr)
* point, if any. */
TkTextIndex breakIndex; /* Index of first character in
* breakChunkPtr. */
- int breakCharOffset; /* Character within breakChunkPtr just
- * to right of best break point. */
+ 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 first character in line. */
+ * style for the first character in
+ * line. */
int jIndent; /* Additional indentation (beyond
* margins) due to justification. */
int rMargin; /* Right margin width for line. */
- Tk_Uid wrapMode; /* Wrap mode to use for this line. */
+ 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
@@ -761,17 +792,18 @@ LayoutDLine(textPtr, indexPtr)
* contains a tab. */
TkTextDispChunk *tabChunkPtr; /* Pointer to the chunk containing
* the previous tab stop. */
- int maxChars; /* Maximum number of characters to
+ int maxBytes; /* Maximum number of bytes to
* include in this chunk. */
- TkTextTabArray *tabArrayPtr; /* Tab stops for line; taken from
- * style for first character on line. */
+ 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 numChars > 0. Used to
+ * lines with numBytes > 0. Used to
* drop 0-sized chunks from the end
* of the line. */
- int offset, ascent, descent, code;
+ int byteOffset, ascent, descent, code, elide, elidesize;
StyleValues *sValuePtr;
/*
@@ -780,7 +812,7 @@ LayoutDLine(textPtr, indexPtr)
dlPtr = (DLine *) ckalloc(sizeof(DLine));
dlPtr->index = *indexPtr;
- dlPtr->count = 0;
+ dlPtr->byteCount = 0;
dlPtr->y = 0;
dlPtr->oldY = -1;
dlPtr->height = 0;
@@ -790,6 +822,37 @@ LayoutDLine(textPtr, indexPtr)
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
@@ -800,14 +863,15 @@ LayoutDLine(textPtr, indexPtr)
lastChunkPtr = NULL;
chunkPtr = NULL;
noCharsYet = 1;
+ elide = 0;
breakChunkPtr = NULL;
- breakCharOffset = 0;
+ breakByteOffset = 0;
justify = TK_JUSTIFY_LEFT;
tabIndex = -1;
tabChunkPtr = NULL;
tabArrayPtr = NULL;
rMargin = 0;
- wrapMode = tkTextCharUid;
+ wrapMode = TEXT_WRAPMODE_CHAR;
tabSize = 0;
lastCharChunkPtr = NULL;
@@ -817,16 +881,48 @@ LayoutDLine(textPtr, indexPtr)
* with zero size (such as the insertion cursor's mark).
*/
- for (offset = curIndex.charIndex, segPtr = curIndex.linePtr->segPtr;
- (offset > 0) && (offset >= segPtr->size);
- offset -= segPtr->size, segPtr = segPtr->nextPtr) {
+ 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;
- offset = 0;
+ byteOffset = 0;
continue;
}
if (chunkPtr == NULL) {
@@ -834,6 +930,7 @@ LayoutDLine(textPtr, indexPtr)
chunkPtr->nextPtr = NULL;
}
chunkPtr->stylePtr = GetStyle(textPtr, &curIndex);
+ elide = chunkPtr->stylePtr->sValuePtr->elide;
/*
* Save style information such as justification and indentation,
@@ -846,11 +943,11 @@ LayoutDLine(textPtr, indexPtr)
justify = chunkPtr->stylePtr->sValuePtr->justify;
rMargin = chunkPtr->stylePtr->sValuePtr->rMargin;
wrapMode = chunkPtr->stylePtr->sValuePtr->wrapMode;
- x = ((curIndex.charIndex == 0)
+ x = ((curIndex.byteIndex == 0)
? chunkPtr->stylePtr->sValuePtr->lMargin1
: chunkPtr->stylePtr->sValuePtr->lMargin2);
- if (wrapMode == tkTextNoneUid) {
- maxX = INT_MAX;
+ if (wrapMode == TEXT_WRAPMODE_NONE) {
+ maxX = -1;
} else {
maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x
- rMargin;
@@ -866,24 +963,37 @@ LayoutDLine(textPtr, indexPtr)
*/
gotTab = 0;
- maxChars = segPtr->size - offset;
- if (justify == TK_JUSTIFY_LEFT) {
+ maxBytes = segPtr->size - byteOffset;
+ if (!elide && justify == TK_JUSTIFY_LEFT) {
if (segPtr->typePtr == &tkTextCharType) {
char *p;
- for (p = segPtr->body.chars + offset; *p != 0; p++) {
+ for (p = segPtr->body.chars + byteOffset; *p != 0; p++) {
if (*p == '\t') {
- maxChars = (p + 1 - segPtr->body.chars) - offset;
+ 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,
- offset, maxX-tabSize, maxChars, noCharsYet, wrapMode,
+ byteOffset, maxX-tabSize, maxBytes, noCharsYet, wrapMode,
chunkPtr);
if (code <= 0) {
FreeStyle(textPtr, chunkPtr->stylePtr);
@@ -894,7 +1004,7 @@ LayoutDLine(textPtr, indexPtr)
*/
segPtr = segPtr->nextPtr;
- offset = 0;
+ byteOffset = 0;
continue;
}
@@ -908,7 +1018,7 @@ LayoutDLine(textPtr, indexPtr)
}
break;
}
- if (chunkPtr->numChars > 0) {
+ if (chunkPtr->numBytes > 0) {
noCharsYet = 0;
lastCharChunkPtr = chunkPtr;
}
@@ -920,11 +1030,11 @@ LayoutDLine(textPtr, indexPtr)
lastChunkPtr = chunkPtr;
x += chunkPtr->width;
if (chunkPtr->breakIndex > 0) {
- breakCharOffset = chunkPtr->breakIndex;
+ breakByteOffset = chunkPtr->breakIndex;
breakIndex = curIndex;
breakChunkPtr = chunkPtr;
}
- if (chunkPtr->numChars != maxChars) {
+ if (chunkPtr->numBytes != maxBytes) {
break;
}
@@ -943,16 +1053,17 @@ LayoutDLine(textPtr, indexPtr)
tabIndex++;
tabChunkPtr = chunkPtr;
tabSize = SizeOfTab(textPtr, tabArrayPtr, tabIndex, x, maxX);
- if (tabSize >= (maxX - x)) {
+ if ((maxX >= 0) && (tabSize >= maxX - x)) {
break;
}
}
- curIndex.charIndex += chunkPtr->numChars;
- offset += chunkPtr->numChars;
- if (offset >= segPtr->size) {
- offset = 0;
+ curIndex.byteIndex += chunkPtr->numBytes;
+ byteOffset += chunkPtr->numBytes;
+ if (byteOffset >= segPtr->size) {
+ byteOffset = 0;
segPtr = segPtr->nextPtr;
}
+
chunkPtr = NULL;
}
if (noCharsYet) {
@@ -976,10 +1087,10 @@ LayoutDLine(textPtr, indexPtr)
*/
breakChunkPtr = lastCharChunkPtr;
- breakCharOffset = breakChunkPtr->numChars;
+ breakByteOffset = breakChunkPtr->numBytes;
}
if ((breakChunkPtr != NULL) && ((lastChunkPtr != breakChunkPtr)
- || (breakCharOffset != lastChunkPtr->numChars))) {
+ || (breakByteOffset != lastChunkPtr->numBytes))) {
while (1) {
chunkPtr = breakChunkPtr->nextPtr;
if (chunkPtr == NULL) {
@@ -990,17 +1101,18 @@ LayoutDLine(textPtr, indexPtr)
(*chunkPtr->undisplayProc)(textPtr, chunkPtr);
ckfree((char *) chunkPtr);
}
- if (breakCharOffset != breakChunkPtr->numChars) {
+ if (breakByteOffset != breakChunkPtr->numBytes) {
(*breakChunkPtr->undisplayProc)(textPtr, breakChunkPtr);
- segPtr = TkTextIndexToSeg(&breakIndex, &offset);
+ segPtr = TkTextIndexToSeg(&breakIndex, &byteOffset);
(*segPtr->typePtr->layoutProc)(textPtr, &breakIndex,
- segPtr, offset, maxX, breakCharOffset, 0,
+ segPtr, byteOffset, maxX, breakByteOffset, 0,
wrapMode, breakChunkPtr);
}
lastChunkPtr = breakChunkPtr;
wholeLine = 0;
}
+
/*
* Make tab adjustments for the last tab stop, if there is one.
*/
@@ -1011,7 +1123,7 @@ LayoutDLine(textPtr, indexPtr)
/*
* Make one more pass over the line to recompute various things
- * like its height, length, and total number of characters. Also
+ * 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,
@@ -1022,7 +1134,7 @@ LayoutDLine(textPtr, indexPtr)
* what is implemented below.
*/
- if (wrapMode == tkTextNoneUid) {
+ if (wrapMode == TEXT_WRAPMODE_NONE) {
maxX = textPtr->dInfoPtr->maxX - textPtr->dInfoPtr->x - rMargin;
}
dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
@@ -1037,7 +1149,7 @@ LayoutDLine(textPtr, indexPtr)
for (chunkPtr = dlPtr->chunkPtr; chunkPtr != NULL;
chunkPtr = chunkPtr->nextPtr) {
chunkPtr->x += jIndent;
- dlPtr->count += chunkPtr->numChars;
+ dlPtr->byteCount += chunkPtr->numBytes;
if (chunkPtr->minAscent > ascent) {
ascent = chunkPtr->minAscent;
}
@@ -1060,7 +1172,7 @@ LayoutDLine(textPtr, indexPtr)
dlPtr->baseline = ascent + (dlPtr->height - ascent - descent)/2;
}
sValuePtr = dlPtr->chunkPtr->stylePtr->sValuePtr;
- if (dlPtr->index.charIndex == 0) {
+ if (dlPtr->index.byteIndex == 0) {
dlPtr->spaceAbove = sValuePtr->spacing1;
} else {
dlPtr->spaceAbove = sValuePtr->spacing2 - sValuePtr->spacing2/2;
@@ -1213,7 +1325,7 @@ UpdateDisplayInfo(textPtr)
* index within the line.
*/
- if (index.charIndex == dlPtr->index.charIndex) {
+ if (index.byteIndex == dlPtr->index.byteIndex) {
/*
* Case (a) -- can use existing display line as-is.
*/
@@ -1224,7 +1336,7 @@ UpdateDisplayInfo(textPtr)
}
goto lineOK;
}
- if (index.charIndex < dlPtr->index.charIndex) {
+ if (index.byteIndex < dlPtr->index.byteIndex) {
goto makeNewDLine;
}
@@ -1251,7 +1363,7 @@ UpdateDisplayInfo(textPtr)
lineOK:
dlPtr->y = y;
y += dlPtr->height;
- TkTextIndexForwChars(&index, dlPtr->count, &index);
+ TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
prevPtr = dlPtr;
dlPtr = dlPtr->nextPtr;
@@ -1302,7 +1414,7 @@ UpdateDisplayInfo(textPtr)
*/
if (y < maxY) {
- int lineNum, spaceLeft, charsToCount;
+ int lineNum, spaceLeft, bytesToCount;
DLine *lowestPtr;
/*
@@ -1315,22 +1427,24 @@ UpdateDisplayInfo(textPtr)
spaceLeft = maxY - y;
lineNum = TkBTreeLineIndex(dInfoPtr->dLinePtr->index.linePtr);
- charsToCount = dInfoPtr->dLinePtr->index.charIndex;
- if (charsToCount == 0) {
- charsToCount = INT_MAX;
+ 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.charIndex = 0;
+ index.byteIndex = 0;
lowestPtr = NULL;
+
do {
dlPtr = LayoutDLine(textPtr, &index);
dlPtr->nextPtr = lowestPtr;
lowestPtr = dlPtr;
- TkTextIndexForwChars(&index, dlPtr->count, &index);
- charsToCount -= dlPtr->count;
- } while ((charsToCount > 0)
+ 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));
/*
@@ -1357,7 +1471,7 @@ UpdateDisplayInfo(textPtr)
}
}
FreeDLines(textPtr, lowestPtr, (DLine *) NULL, 0);
- charsToCount = INT_MAX;
+ bytesToCount = INT_MAX;
}
/*
@@ -1444,13 +1558,13 @@ UpdateDisplayInfo(textPtr)
}
maxOffset = (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
+ textPtr->charWidth - 1)/textPtr->charWidth;
- if (dInfoPtr->newCharOffset > maxOffset) {
- dInfoPtr->newCharOffset = maxOffset;
+ if (dInfoPtr->newByteOffset > maxOffset) {
+ dInfoPtr->newByteOffset = maxOffset;
}
- if (dInfoPtr->newCharOffset < 0) {
- dInfoPtr->newCharOffset = 0;
+ if (dInfoPtr->newByteOffset < 0) {
+ dInfoPtr->newByteOffset = 0;
}
- pixelOffset = dInfoPtr->newCharOffset * textPtr->charWidth;
+ pixelOffset = dInfoPtr->newByteOffset * textPtr->charWidth;
if (pixelOffset != dInfoPtr->curPixelOffset) {
dInfoPtr->curPixelOffset = pixelOffset;
for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
@@ -1557,6 +1671,8 @@ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap)
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.
@@ -1580,11 +1696,7 @@ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap)
* to its left.
*/
-#ifndef __WIN32__
- /* CYGNUS LOCAL: On Windows, display the cursor even for disabled
- text widgets. */
- if (textPtr->state == tkNormalUid) {
-#endif /* __WIN32__ */
+ if (textPtr->state == TK_STATE_NORMAL) {
for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
chunkPtr = chunkPtr->nextPtr) {
x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
@@ -1595,9 +1707,7 @@ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap)
dlPtr->y + dlPtr->spaceAbove);
}
}
-#ifndef __WIN32__
}
-#endif /* __WIN32__ */
/*
* Make yet another pass through all of the chunks to redraw all of
@@ -1629,12 +1739,16 @@ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap)
* 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,
@@ -1723,6 +1837,7 @@ DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap)
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
@@ -1796,7 +1911,7 @@ DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap)
rightX = maxX;
}
chunkPtr2 = NULL;
- if (prevPtr != NULL) {
+ if (prevPtr != NULL && prevPtr->chunkPtr != NULL) {
/*
* Find the chunk in the previous line that covers leftX.
*/
@@ -1917,7 +2032,7 @@ DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap)
rightX = maxX;
}
chunkPtr2 = NULL;
- if (dlPtr->nextPtr != NULL) {
+ if (dlPtr->nextPtr != NULL && dlPtr->nextPtr->chunkPtr != NULL) {
/*
* Find the chunk in the previous line that covers leftX.
*/
@@ -2243,17 +2358,19 @@ DisplayText(clientData)
Tk_Height(textPtr->tkwin) - 2*textPtr->highlightWidth,
textPtr->borderWidth, textPtr->relief);
if (textPtr->highlightWidth != 0) {
- GC gc;
+ GC fgGC, bgGC;
+ bgGC = Tk_GCForColor(textPtr->highlightBgColorPtr,
+ Tk_WindowId(textPtr->tkwin));
if (textPtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(textPtr->highlightColorPtr,
+ fgGC = Tk_GCForColor(textPtr->highlightColorPtr,
Tk_WindowId(textPtr->tkwin));
+ TkpDrawHighlightBorder(textPtr->tkwin, fgGC, bgGC,
+ textPtr->highlightWidth, Tk_WindowId(textPtr->tkwin));
} else {
- gc = Tk_GCForColor(textPtr->highlightBgColorPtr,
- Tk_WindowId(textPtr->tkwin));
+ TkpDrawHighlightBorder(textPtr->tkwin, bgGC, bgGC,
+ textPtr->highlightWidth, Tk_WindowId(textPtr->tkwin));
}
- Tk_DrawFocusHighlight(textPtr->tkwin, gc, textPtr->highlightWidth,
- Tk_WindowId(textPtr->tkwin));
}
borders = textPtr->borderWidth + textPtr->highlightWidth;
if (textPtr->padY > 0) {
@@ -2308,6 +2425,7 @@ DisplayText(clientData)
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];
@@ -2324,6 +2442,7 @@ DisplayText(clientData)
dlPtr->oldY = dlPtr->y;
dlPtr->flags &= ~NEW_LAYOUT;
}
+ /*prevPtr = dlPtr;*/
}
Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
}
@@ -2600,7 +2719,7 @@ TkTextChanged(textPtr, index1Ptr, index2Ptr)
*/
rounded = *index1Ptr;
- rounded.charIndex = 0;
+ rounded.byteIndex = 0;
firstPtr = FindDLine(dInfoPtr->dLinePtr, &rounded);
if (firstPtr == NULL) {
return;
@@ -2676,7 +2795,7 @@ TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag)
*/
if (index2Ptr == NULL) {
- index2Ptr = TkTextMakeIndex(textPtr->tree,
+ index2Ptr = TkTextMakeByteIndex(textPtr->tree,
TkBTreeNumLines(textPtr->tree), 0, &endOfText);
}
@@ -2730,13 +2849,13 @@ TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag)
* previous character.
*/
- if (curIndexPtr->charIndex == 0) {
+ if (curIndexPtr->byteIndex == 0) {
dlPtr = FindDLine(dlPtr, curIndexPtr);
} else {
TkTextIndex tmp;
tmp = *curIndexPtr;
- tmp.charIndex -= 1;
+ tmp.byteIndex -= 1;
dlPtr = FindDLine(dlPtr, &tmp);
}
if (dlPtr == NULL) {
@@ -2755,7 +2874,7 @@ TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag)
}
endPtr = FindDLine(dlPtr, endIndexPtr);
if ((endPtr != NULL) && (endPtr->index.linePtr == endIndexPtr->linePtr)
- && (endPtr->index.charIndex < endIndexPtr->charIndex)) {
+ && (endPtr->index.byteIndex < endIndexPtr->byteIndex)) {
endPtr = endPtr->nextPtr;
}
@@ -2867,7 +2986,7 @@ TkTextRelayoutWindow(textPtr)
* or options could change the way lines wrap.
*/
- if (textPtr->topIndex.charIndex != 0) {
+ if (textPtr->topIndex.byteIndex != 0) {
MeasureUp(textPtr, &textPtr->topIndex, 0, &textPtr->topIndex);
}
@@ -2934,7 +3053,7 @@ TkTextSetYView(textPtr, indexPtr, pickPlace)
* without redisplaying it all.
*/
- if (indexPtr->charIndex == 0) {
+ if (indexPtr->byteIndex == 0) {
textPtr->topIndex = *indexPtr;
} else {
MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex);
@@ -2962,7 +3081,7 @@ TkTextSetYView(textPtr, indexPtr, pickPlace)
dlPtr = NULL;
} else if ((dlPtr->index.linePtr == indexPtr->linePtr)
- && (dlPtr->index.charIndex <= indexPtr->charIndex)) {
+ && (dlPtr->index.byteIndex <= indexPtr->byteIndex)) {
return;
}
}
@@ -3060,37 +3179,37 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr)
TkTextIndex *dstPtr; /* Index to fill in with result. */
{
int lineNum; /* Number of current line. */
- int charsToCount; /* Maximum number of characters to measure
- * in current line. */
+ 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;
- charsToCount = srcPtr->charIndex + 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 (charsToCount is non-infinite to
+ * 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.charIndex = 0;
+ index.byteIndex = 0;
lowestPtr = NULL;
do {
dlPtr = LayoutDLine(textPtr, &index);
dlPtr->nextPtr = lowestPtr;
lowestPtr = dlPtr;
- TkTextIndexForwChars(&index, dlPtr->count, &index);
- charsToCount -= dlPtr->count;
- } while ((charsToCount > 0) && (index.linePtr == dlPtr->index.linePtr));
+ 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
@@ -3117,7 +3236,7 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr)
if (distance < 0) {
return;
}
- charsToCount = INT_MAX; /* Consider all chars. in next line. */
+ bytesToCount = INT_MAX; /* Consider all chars. in next line. */
}
/*
@@ -3125,7 +3244,7 @@ MeasureUp(textPtr, srcPtr, distance, dstPtr)
* in the text.
*/
- TkTextMakeIndex(textPtr->tree, 0, 0, dstPtr);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, dstPtr);
}
/*
@@ -3157,7 +3276,7 @@ TkTextSeeCmd(textPtr, interp, argc, argv)
{
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
TkTextIndex index;
- int x, y, width, height, lineWidth, charCount, oneThird, delta;
+ int x, y, width, height, lineWidth, byteCount, oneThird, delta;
DLine *dlPtr;
TkTextDispChunk *chunkPtr;
@@ -3166,7 +3285,6 @@ TkTextSeeCmd(textPtr, interp, argc, argv)
argv[0], " see index\"", (char *) NULL);
return TCL_ERROR;
}
-
if (TkTextGetIndex(interp, textPtr, argv[2], &index) != TCL_OK) {
return TCL_ERROR;
}
@@ -3203,27 +3321,12 @@ TkTextSeeCmd(textPtr, interp, argc, argv)
*/
dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
-
- /*
- * CYGNUS LOCAL: I can sometimes get FindDLine to return a null
- * pointer. I have not been able to find a simple test case,
- * it happens in Gdbtk when you change the font for the debug window.
- * Since you should not have to catch the see command, I have made
- * the error silent...
- */
-
- if (dlPtr == NULL) {
- Tcl_AppendResult(interp, "got a null dlinePtr from FindDLine in the see command.",
- (char *) NULL);
- return TCL_OK;
- }
-
- charCount = index.charIndex - dlPtr->index.charIndex;
- for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
- if (charCount < chunkPtr->numChars) {
+ byteCount = index.byteIndex - dlPtr->index.byteIndex;
+ for (chunkPtr = dlPtr->chunkPtr; chunkPtr!=NULL ; chunkPtr = chunkPtr->nextPtr) {
+ if (byteCount < chunkPtr->numBytes) {
break;
}
- charCount -= chunkPtr->numChars;
+ byteCount -= chunkPtr->numBytes;
}
/*
@@ -3231,7 +3334,8 @@ TkTextSeeCmd(textPtr, interp, argc, argv)
* the character within the chunk.
*/
- (*chunkPtr->bboxProc)(chunkPtr, charCount, dlPtr->y + dlPtr->spaceAbove,
+ 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);
@@ -3239,24 +3343,24 @@ TkTextSeeCmd(textPtr, interp, argc, argv)
oneThird = lineWidth/3;
if (delta < 0) {
if (delta < -oneThird) {
- dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth;
+ dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth;
} else {
- dInfoPtr->newCharOffset -= ((-delta) + textPtr->charWidth - 1)
+ dInfoPtr->newByteOffset -= ((-delta) + textPtr->charWidth - 1)
/ textPtr->charWidth;
}
} else {
delta -= (lineWidth - width);
if (delta > 0) {
if (delta > oneThird) {
- dInfoPtr->newCharOffset = (x - lineWidth/2)/textPtr->charWidth;
+ dInfoPtr->newByteOffset = (x - lineWidth/2)/textPtr->charWidth;
} else {
- dInfoPtr->newCharOffset += (delta + textPtr->charWidth - 1)
+ 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;
@@ -3305,7 +3409,7 @@ TkTextXviewCmd(textPtr, interp, argc, argv)
return TCL_OK;
}
- newOffset = dInfoPtr->newCharOffset;
+ newOffset = dInfoPtr->newByteOffset;
type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
switch (type) {
case TK_SCROLL_ERROR:
@@ -3326,14 +3430,14 @@ TkTextXviewCmd(textPtr, interp, argc, argv)
if (charsPerPage < 1) {
charsPerPage = 1;
}
- newOffset += charsPerPage*count;
+ newOffset += charsPerPage * count;
break;
case TK_SCROLL_UNITS:
newOffset += count;
break;
}
- dInfoPtr->newCharOffset = newOffset;
+ dInfoPtr->newByteOffset = newOffset;
dInfoPtr->flags |= DINFO_OUT_OF_DATE;
if (!(dInfoPtr->flags & REDRAW_PENDING)) {
dInfoPtr->flags |= REDRAW_PENDING;
@@ -3369,7 +3473,7 @@ ScrollByLines(textPtr, offset)
* means that information earlier in the
* text becomes visible. */
{
- int i, charsToCount, lineNum;
+ int i, bytesToCount, lineNum;
TkTextIndex new, index;
TkTextLine *lastLinePtr;
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
@@ -3382,21 +3486,21 @@ ScrollByLines(textPtr, offset)
* it counts lines instead of pixels.
*/
- charsToCount = textPtr->topIndex.charIndex + 1;
+ 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.charIndex = 0;
+ index.byteIndex = 0;
lowestPtr = NULL;
do {
dlPtr = LayoutDLine(textPtr, &index);
dlPtr->nextPtr = lowestPtr;
lowestPtr = dlPtr;
- TkTextIndexForwChars(&index, dlPtr->count, &index);
- charsToCount -= dlPtr->count;
- } while ((charsToCount > 0)
+ TkTextIndexForwBytes(&index, dlPtr->byteCount, &index);
+ bytesToCount -= dlPtr->byteCount;
+ } while ((bytesToCount > 0)
&& (index.linePtr == dlPtr->index.linePtr));
for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
@@ -3406,7 +3510,7 @@ ScrollByLines(textPtr, offset)
break;
}
}
-
+
/*
* Discard the display lines, then either return or prepare
* for the next display line to lay out.
@@ -3416,7 +3520,7 @@ ScrollByLines(textPtr, offset)
if (offset >= 0) {
goto scheduleUpdate;
}
- charsToCount = INT_MAX;
+ bytesToCount = INT_MAX;
}
/*
@@ -3424,7 +3528,7 @@ ScrollByLines(textPtr, offset)
* in the text.
*/
- TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->topIndex);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &textPtr->topIndex);
} else {
/*
* Scrolling down, to show later information in the text.
@@ -3435,8 +3539,9 @@ ScrollByLines(textPtr, offset)
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;
- TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count, &new);
+ TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount, &new);
FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
if (new.linePtr == lastLinePtr) {
break;
@@ -3480,7 +3585,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv)
* argv[1] is "yview". */
{
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
- int pickPlace, lineNum, type, charsInLine;
+ int pickPlace, lineNum, type, bytesInLine;
Tk_FontMetrics fm;
int pixels, count;
size_t switchLength;
@@ -3518,7 +3623,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv)
}
if ((argc == 3) || pickPlace) {
if (Tcl_GetInt(interp, argv[2+pickPlace], &lineNum) == TCL_OK) {
- TkTextMakeIndex(textPtr->tree, lineNum, 0, &index);
+ TkTextMakeByteIndex(textPtr->tree, lineNum, 0, &index);
TkTextSetYView(textPtr, &index, 0);
return TCL_OK;
}
@@ -3553,11 +3658,11 @@ TkTextYviewCmd(textPtr, interp, argc, argv)
}
fraction *= TkBTreeNumLines(textPtr->tree);
lineNum = (int) fraction;
- TkTextMakeIndex(textPtr->tree, lineNum, 0, &index);
- charsInLine = TkBTreeCharsInLine(index.linePtr);
- index.charIndex = (int)((charsInLine * (fraction-lineNum)) + 0.5);
- if (index.charIndex >= charsInLine) {
- TkTextMakeIndex(textPtr->tree, lineNum+1, 0, &index);
+ 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;
@@ -3595,7 +3700,7 @@ TkTextYviewCmd(textPtr, interp, argc, argv)
do {
dlPtr = LayoutDLine(textPtr, &textPtr->topIndex);
dlPtr->nextPtr = NULL;
- TkTextIndexForwChars(&textPtr->topIndex, dlPtr->count,
+ TkTextIndexForwBytes(&textPtr->topIndex, dlPtr->byteCount,
&new);
pixels -= dlPtr->height;
FreeDLines(textPtr, dlPtr, (DLine *) NULL, 0);
@@ -3647,13 +3752,14 @@ TkTextScanCmd(textPtr, interp, argc, argv)
{
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
TkTextIndex index;
- int c, x, y, totalScroll, newChar, maxChar;
+ int c, x, y, totalScroll, newByte, maxByte, gain=10;
Tk_FontMetrics fm;
size_t length;
- if (argc != 5) {
+ if ((argc != 5) && (argc != 6)) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
- argv[0], " scan mark|dragto x y\"", (char *) NULL);
+ 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) {
@@ -3662,6 +3768,8 @@ TkTextScanCmd(textPtr, interp, argc, argv)
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)) {
@@ -3677,33 +3785,35 @@ TkTextScanCmd(textPtr, interp, argc, argv)
* moving again).
*/
- newChar = dInfoPtr->scanMarkChar + (10*(dInfoPtr->scanMarkX - x))
+ newByte = dInfoPtr->scanMarkIndex + (gain*(dInfoPtr->scanMarkX - x))
/ (textPtr->charWidth);
- maxChar = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
+ maxByte = 1 + (dInfoPtr->maxLength - (dInfoPtr->maxX - dInfoPtr->x)
+ textPtr->charWidth - 1)/textPtr->charWidth;
- if (newChar < 0) {
- dInfoPtr->scanMarkChar = newChar = 0;
+ if (newByte < 0) {
+ newByte = 0;
+ dInfoPtr->scanMarkIndex = 0;
dInfoPtr->scanMarkX = x;
- } else if (newChar > maxChar) {
- dInfoPtr->scanMarkChar = newChar = maxChar;
+ } else if (newByte > maxByte) {
+ newByte = maxByte;
+ dInfoPtr->scanMarkIndex = maxByte;
dInfoPtr->scanMarkX = x;
}
- dInfoPtr->newCharOffset = newChar;
+ dInfoPtr->newByteOffset = newByte;
Tk_GetFontMetrics(textPtr->tkfont, &fm);
- totalScroll = (10*(dInfoPtr->scanMarkY - y)) / fm.linespace;
+ 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.charIndex == textPtr->topIndex.charIndex)) {
+ (index.byteIndex == textPtr->topIndex.byteIndex)) {
dInfoPtr->scanTotalScroll = 0;
dInfoPtr->scanMarkY = y;
}
}
} else if ((c == 'm') && (strncmp(argv[2], "mark", length) == 0)) {
- dInfoPtr->scanMarkChar = dInfoPtr->newCharOffset;
+ dInfoPtr->scanMarkIndex = dInfoPtr->newByteOffset;
dInfoPtr->scanMarkX = x;
dInfoPtr->scanTotalScroll = 0;
dInfoPtr->scanMarkY = y;
@@ -3730,11 +3840,11 @@ TkTextScanCmd(textPtr, interp, argc, argv)
* Tcl script to report them to the text's associated scrollbar.
*
* Results:
- * If report is zero, then interp->result is filled in with
+ * 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 interp->result isn't modified
+ * 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).
@@ -3749,13 +3859,13 @@ static void
GetXView(interp, textPtr, report)
Tcl_Interp *interp; /* If "report" is FALSE, string
* describing visible range gets
- * stored in interp->result. */
+ * 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[200];
+ char buffer[TCL_DOUBLE_SPACE * 2];
double first, last;
int code;
@@ -3772,7 +3882,8 @@ GetXView(interp, textPtr, report)
last = 1.0;
}
if (!report) {
- sprintf(interp->result, "%g %g", first, last);
+ sprintf(buffer, "%g %g", first, last);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
return;
}
if ((first == dInfoPtr->xScrollFirst) && (last == dInfoPtr->xScrollLast)) {
@@ -3800,11 +3911,11 @@ GetXView(interp, textPtr, report)
* Tcl script to report them to the text's associated scrollbar.
*
* Results:
- * If report is zero, then interp->result is filled in with
+ * 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 interp->result isn't modified directly,
+ * 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).
@@ -3819,22 +3930,22 @@ static void
GetYView(interp, textPtr, report)
Tcl_Interp *interp; /* If "report" is FALSE, string
* describing visible range gets
- * stored in interp->result. */
+ * 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[200];
+ char buffer[TCL_DOUBLE_SPACE * 2];
double first, last;
DLine *dlPtr;
int totalLines, code, count;
dlPtr = dInfoPtr->dLinePtr;
totalLines = TkBTreeNumLines(textPtr->tree);
- first = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
- + ((double) dlPtr->index.charIndex)
- / (TkBTreeCharsInLine(dlPtr->index.linePtr));
+ 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) {
@@ -3846,17 +3957,18 @@ GetYView(interp, textPtr, report)
break;
}
if (dlPtr->nextPtr == NULL) {
- count = dlPtr->count;
+ count = dlPtr->byteCount;
break;
}
dlPtr = dlPtr->nextPtr;
}
last = ((double) TkBTreeLineIndex(dlPtr->index.linePtr))
- + ((double) (dlPtr->index.charIndex + count))
- / (TkBTreeCharsInLine(dlPtr->index.linePtr));
+ + ((double) (dlPtr->index.byteIndex + count))
+ / (TkBTreeBytesInLine(dlPtr->index.linePtr));
last /= totalLines;
if (!report) {
- sprintf(interp->result, "%g %g", first, last);
+ sprintf(buffer, "%g %g", first, last);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
return;
}
if ((first == dInfoPtr->yScrollFirst) && (last == dInfoPtr->yScrollLast)) {
@@ -3865,8 +3977,7 @@ GetYView(interp, textPtr, report)
dInfoPtr->yScrollFirst = first;
dInfoPtr->yScrollLast = last;
sprintf(buffer, " %g %g", first, last);
- code = Tcl_VarEval(interp, textPtr->yScrollCmd,
- buffer, (char *) NULL);
+ code = Tcl_VarEval(interp, textPtr->yScrollCmd, buffer, (char *) NULL);
if (code != TCL_OK) {
Tcl_AddErrorInfo(interp,
"\n (vertical scrolling command executed by text)");
@@ -3938,7 +4049,7 @@ FindDLine(dlPtr, indexPtr)
* Now get to the right position within the text line.
*/
- while (indexPtr->charIndex >= (dlPtr->index.charIndex + dlPtr->count)) {
+ while (indexPtr->byteIndex >= (dlPtr->index.byteIndex + dlPtr->byteCount)) {
dlPtr = dlPtr->nextPtr;
if ((dlPtr == NULL) || (dlPtr->index.linePtr != indexPtr->linePtr)) {
break;
@@ -3974,7 +4085,7 @@ TkTextPixelIndex(textPtr, x, y, indexPtr)
* index of the character nearest to (x,y). */
{
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
- register DLine *dlPtr;
+ register DLine *dlPtr, *validdlPtr;
register TkTextDispChunk *chunkPtr;
/*
@@ -4007,8 +4118,9 @@ TkTextPixelIndex(textPtr, x, y, indexPtr)
* Find the display line containing the desired y-coordinate.
*/
- for (dlPtr = dInfoPtr->dLinePtr; y >= (dlPtr->y + dlPtr->height);
+ 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.
@@ -4019,6 +4131,8 @@ TkTextPixelIndex(textPtr, x, y, indexPtr)
break;
}
}
+ if (dlPtr->chunkPtr == NULL) dlPtr = validdlPtr;
+
/*
* Scan through the line's chunks to find the one that contains
@@ -4030,21 +4144,22 @@ TkTextPixelIndex(textPtr, x, y, indexPtr)
*indexPtr = dlPtr->index;
x = x - dInfoPtr->x + dInfoPtr->curPixelOffset;
for (chunkPtr = dlPtr->chunkPtr; x >= (chunkPtr->x + chunkPtr->width);
- indexPtr->charIndex += chunkPtr->numChars,
+ indexPtr->byteIndex += chunkPtr->numBytes,
chunkPtr = chunkPtr->nextPtr) {
if (chunkPtr->nextPtr == NULL) {
- indexPtr->charIndex += chunkPtr->numChars - 1;
+ indexPtr->byteIndex += chunkPtr->numBytes;
+ TkTextIndexBackChars(indexPtr, 1, indexPtr);
return;
}
}
/*
- * If the chunk has more than one character in it, ask it which
+ * If the chunk has more than one byte in it, ask it which
* character is at the desired location.
*/
- if (chunkPtr->numChars > 1) {
- indexPtr->charIndex += (*chunkPtr->measureProc)(chunkPtr, x);
+ if (chunkPtr->numBytes > 1) {
+ indexPtr->byteIndex += (*chunkPtr->measureProc)(chunkPtr, x);
}
}
@@ -4081,7 +4196,7 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr)
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
DLine *dlPtr;
register TkTextDispChunk *chunkPtr;
- int index;
+ int byteIndex;
/*
* Make sure that all of the screen layout information is up to date.
@@ -4105,15 +4220,15 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr)
* index.
*/
- index = indexPtr->charIndex - dlPtr->index.charIndex;
+ byteIndex = indexPtr->byteIndex - dlPtr->index.byteIndex;
for (chunkPtr = dlPtr->chunkPtr; ; chunkPtr = chunkPtr->nextPtr) {
if (chunkPtr == NULL) {
return -1;
}
- if (index < chunkPtr->numChars) {
+ if (byteIndex < chunkPtr->numBytes) {
break;
}
- index -= chunkPtr->numChars;
+ byteIndex -= chunkPtr->numBytes;
}
/*
@@ -4124,12 +4239,12 @@ TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr)
* horizontal scrolling.
*/
- (*chunkPtr->bboxProc)(chunkPtr, index, dlPtr->y + dlPtr->spaceAbove,
+ (*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 ((index == (chunkPtr->numChars-1)) && (chunkPtr->nextPtr == NULL)) {
+ if ((byteIndex == (chunkPtr->numBytes - 1)) && (chunkPtr->nextPtr == NULL)) {
/*
* Last character in display line. Give it all the space up to
* the line.
@@ -4191,6 +4306,7 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
{
TextDInfo *dInfoPtr = textPtr->dInfoPtr;
DLine *dlPtr;
+ int dlx;
/*
* Make sure that all of the screen layout information is up to date.
@@ -4209,8 +4325,9 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
return -1;
}
- *xPtr = dInfoPtr->x - dInfoPtr->curPixelOffset + dlPtr->chunkPtr->x;
- *widthPtr = dlPtr->length - dlPtr->chunkPtr->x;
+ 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;
@@ -4221,6 +4338,41 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
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*/;
+}
+
/*
*--------------------------------------------------------------
*
@@ -4228,7 +4380,7 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
*
* This procedure is the "layoutProc" for character segments.
*
- * Results:
+n * Results:
* If there is something to display for the chunk then a
* non-zero value is returned and the fields of chunkPtr
* will be filled in (see the declaration of TkTextDispChunk
@@ -4245,29 +4397,29 @@ TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
*/
int
-TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
+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 offset; /* Offset within segment of first character
- * to consider. */
+ int byteOffset; /* Byte offset within segment of first
+ * character to consider. */
int maxX; /* Chunk must not occupy pixels at this
* position or higher. */
- int maxChars; /* Chunk must not include more than this
+ int maxBytes; /* Chunk must not include more than this
* many characters. */
int noCharsYet; /* Non-zero means no characters have been
* assigned to this display line yet. */
- Tk_Uid wrapMode; /* How to handle line wrapping: tkTextCharUid,
- * tkTextNoneUid, or tkTextWordUid. */
+ 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, charsThatFit, count;
+ int nextX, bytesThatFit, count;
CharInfo *ciPtr;
char *p;
TkTextSegment *nextPtr;
@@ -4285,17 +4437,19 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
* is a white space character.
*/
- p = segPtr->body.chars + offset;
+ p = segPtr->body.chars + byteOffset;
tkfont = chunkPtr->stylePtr->sValuePtr->tkfont;
- charsThatFit = MeasureChars(tkfont, p, maxChars, chunkPtr->x, maxX, 0,
+ bytesThatFit = MeasureChars(tkfont, p, maxBytes, chunkPtr->x, maxX, 0,
&nextX);
- if (charsThatFit < maxChars) {
- if ((charsThatFit == 0) && noCharsYet) {
- charsThatFit = 1;
- MeasureChars(tkfont, p, 1, chunkPtr->x, INT_MAX, 0, &nextX);
+ if (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[charsThatFit] == ' ')
- || (p[charsThatFit] == '\t'))) {
+ 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
@@ -4303,17 +4457,17 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
*/
nextX = maxX;
- charsThatFit++;
+ bytesThatFit++;
}
- if (p[charsThatFit] == '\n') {
+ if (p[bytesThatFit] == '\n') {
/*
* A newline character takes up no space, so if the previous
* character fits then so does the newline.
*/
- charsThatFit++;
+ bytesThatFit++;
}
- if (charsThatFit == 0) {
+ if (bytesThatFit == 0) {
return 0;
}
}
@@ -4330,19 +4484,19 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
chunkPtr->undisplayProc = CharUndisplayProc;
chunkPtr->measureProc = CharMeasureProc;
chunkPtr->bboxProc = CharBboxProc;
- chunkPtr->numChars = charsThatFit;
+ 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 + charsThatFit));
+ (sizeof(CharInfo) - 3 + bytesThatFit));
chunkPtr->clientData = (ClientData) ciPtr;
- ciPtr->numChars = charsThatFit;
- strncpy(ciPtr->chars, p, (size_t) charsThatFit);
- if (p[charsThatFit-1] == '\n') {
- ciPtr->numChars--;
+ ciPtr->numBytes = bytesThatFit;
+ strncpy(ciPtr->chars, p, (size_t) bytesThatFit);
+ if (p[bytesThatFit - 1] == '\n') {
+ ciPtr->numBytes--;
}
/*
@@ -4352,22 +4506,22 @@ TkTextCharLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
* is not a character segment.
*/
- if (wrapMode != tkTextWordUid) {
- chunkPtr->breakIndex = chunkPtr->numChars;
+ if (wrapMode != TEXT_WRAPMODE_WORD) {
+ chunkPtr->breakIndex = chunkPtr->numBytes;
} else {
- for (count = charsThatFit, p += charsThatFit-1; count > 0;
+ for (count = bytesThatFit, p += bytesThatFit - 1; count > 0;
count--, p--) {
if (isspace(UCHAR(*p))) {
chunkPtr->breakIndex = count;
break;
}
}
- if ((charsThatFit+offset) == segPtr->size) {
+ 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->numChars;
+ chunkPtr->breakIndex = chunkPtr->numBytes;
}
break;
}
@@ -4414,7 +4568,7 @@ CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
TextStyle *stylePtr;
StyleValues *sValuePtr;
- int offsetChars, offsetX;
+ int offsetBytes, offsetX;
if ((x + chunkPtr->width) <= 0) {
/*
@@ -4436,30 +4590,29 @@ CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
*/
offsetX = x;
- offsetChars = 0;
+ offsetBytes = 0;
if (x < 0) {
- offsetChars = MeasureChars(sValuePtr->tkfont, ciPtr->chars,
- ciPtr->numChars, x, 0, x - chunkPtr->x, &offsetX);
+ offsetBytes = MeasureChars(sValuePtr->tkfont, ciPtr->chars,
+ ciPtr->numBytes, x, 0, x - chunkPtr->x, &offsetX);
}
/*
* Draw the text, underline, and overstrike for this chunk.
*/
- if (ciPtr->numChars > offsetChars) {
- int numChars = ciPtr->numChars - offsetChars;
- char *string = ciPtr->chars + offsetChars;
+ if (!sValuePtr->elide && (ciPtr->numBytes > offsetBytes) && (stylePtr->fgGC != None)) {
+ int numBytes = ciPtr->numBytes - offsetBytes;
+ char *string = ciPtr->chars + offsetBytes;
- if ((numChars > 0) && (string[numChars - 1] == '\t')) {
- numChars--;
+ if ((numBytes > 0) && (string[numBytes - 1] == '\t')) {
+ numBytes--;
}
Tk_DrawChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont, string,
- numChars, offsetX, y + baseline - sValuePtr->offset);
+ numBytes, offsetX, y + baseline - sValuePtr->offset);
if (sValuePtr->underline) {
Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
- ciPtr->chars + offsetChars, offsetX,
- y + baseline - sValuePtr->offset,
- 0, numChars);
+ ciPtr->chars + offsetBytes, offsetX,
+ y + baseline - sValuePtr->offset, 0, numBytes);
}
if (sValuePtr->overstrike) {
@@ -4467,10 +4620,10 @@ CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
Tk_GetFontMetrics(sValuePtr->tkfont, &fm);
Tk_UnderlineChars(display, dst, stylePtr->fgGC, sValuePtr->tkfont,
- ciPtr->chars + offsetChars, offsetX,
+ ciPtr->chars + offsetBytes, offsetX,
y + baseline - sValuePtr->offset
- fm.descent - (fm.ascent * 3) / 10,
- 0, numChars);
+ 0, numBytes);
}
}
}
@@ -4532,7 +4685,8 @@ CharMeasureProc(chunkPtr, x)
int endX;
return MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
- chunkPtr->numChars-1, chunkPtr->x, x, 0, &endX);
+ chunkPtr->numBytes - 1, chunkPtr->x, x, 0, &endX);
+ /* CHAR OFFSET */
}
/*
@@ -4559,11 +4713,11 @@ CharMeasureProc(chunkPtr, x)
*/
static void
-CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
+CharBboxProc(chunkPtr, byteIndex, y, lineHeight, baseline, xPtr, yPtr,
widthPtr, heightPtr)
TkTextDispChunk *chunkPtr; /* Chunk containing desired char. */
- int index; /* Index of desired character within
- * the chunk. */
+ 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. */
@@ -4582,10 +4736,10 @@ CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
int maxX;
maxX = chunkPtr->width + chunkPtr->x;
- MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars, index,
- chunkPtr->x, 1000000, 0, xPtr);
+ MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont, ciPtr->chars,
+ byteIndex, chunkPtr->x, -1, 0, xPtr);
- if (index == ciPtr->numChars) {
+ 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
@@ -4593,8 +4747,8 @@ CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
*/
*widthPtr = maxX - *xPtr;
- } else if ((ciPtr->chars[index] == '\t')
- && (index == (ciPtr->numChars-1))) {
+ } 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.
@@ -4603,7 +4757,7 @@ CharBboxProc(chunkPtr, index, y, lineHeight, baseline, xPtr, yPtr,
*widthPtr = maxX - *xPtr;
} else {
MeasureChars(chunkPtr->stylePtr->sValuePtr->tkfont,
- ciPtr->chars + index, 1, *xPtr, 1000000, 0, widthPtr);
+ ciPtr->chars + byteIndex, 1, *xPtr, -1, 0, widthPtr);
if (*widthPtr > maxX) {
*widthPtr = maxX - *xPtr;
} else {
@@ -4738,7 +4892,7 @@ AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr)
continue;
}
ciPtr = (CharInfo *) chunkPtr2->clientData;
- for (p = ciPtr->chars, i = 0; i < ciPtr->numChars; p++, i++) {
+ for (p = ciPtr->chars, i = 0; i < ciPtr->numBytes; p++, i++) {
if (isdigit(UCHAR(*p))) {
gotDigit = 1;
} else if ((*p == '.') || (*p == ',')) {
@@ -4759,7 +4913,7 @@ AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr)
ciPtr = (CharInfo *) decimalChunkPtr->clientData;
MeasureChars(decimalChunkPtr->stylePtr->sValuePtr->tkfont,
- ciPtr->chars, decimal, decimalChunkPtr->x, 1000000, 0, &curX);
+ ciPtr->chars, decimal, decimalChunkPtr->x, -1, 0, &curX);
desired = tabX - (curX - x);
goto update;
} else {
@@ -4784,7 +4938,7 @@ AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr)
update:
delta = desired - x;
- MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth);
+ MeasureChars(textPtr->tkfont, " ", 1, 0, -1, 0, &spaceWidth);
if (delta < spaceWidth) {
delta = spaceWidth;
}
@@ -4889,7 +5043,7 @@ SizeOfTab(textPtr, tabArrayPtr, index, x, maxX)
}
done:
- MeasureChars(textPtr->tkfont, " ", 1, 0, INT_MAX, 0, &spaceWidth);
+ MeasureChars(textPtr->tkfont, " ", 1, 0, -1, 0, &spaceWidth);
if (result < spaceWidth) {
result = spaceWidth;
}
@@ -4953,7 +5107,7 @@ NextTabStop(textPtr, tkfont, x, tabOrigin)
*
* Determine the number of characters from the string that will fit
* in the given horizontal span. The measurement is done under the
- * assumption that Tk_DisplayChars will be used to actually display
+ * assumption that Tk_DrawTextLayout will be used to actually display
* the characters.
*
* If tabs are encountered in the string, they will be expanded
@@ -4964,7 +5118,7 @@ NextTabStop(textPtr, tkfont, x, tabOrigin)
* is specified.
*
* Results:
- * The return value is the number of characters from source
+ * 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
@@ -4977,11 +5131,11 @@ NextTabStop(textPtr, tkfont, x, tabOrigin)
*/
static int
-MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr)
+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 maxChars; /* Maximum # of characters to consider from
+ int maxBytes; /* Maximum # of bytes to consider from
* source. */
int startX; /* X-position at which first character will
* be drawn. */
@@ -4998,7 +5152,7 @@ MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr)
ch = 0; /* lint. */
curX = startX;
special = source;
- end = source + maxChars;
+ end = source + maxBytes;
for (start = source; start < end; ) {
if (start >= special) {
/*
@@ -5018,7 +5172,7 @@ MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr)
* string). Process characters between start and special.
*/
- if (curX >= maxX) {
+ if ((maxX >= 0) && (curX >= maxX)) {
break;
}
start += Tk_MeasureChars(tkfont, start, special - start, maxX - curX,
@@ -5043,3 +5197,4 @@ MeasureChars(tkfont, source, maxChars, startX, maxX, tabOrigin, nextXPtr)
*nextXPtr = curX;
return start - source;
}
+
diff --git a/tk/generic/tkTextImage.c b/tk/generic/tkTextImage.c
index 2083d101895..01757b071f8 100644
--- a/tk/generic/tkTextImage.c
+++ b/tk/generic/tkTextImage.c
@@ -5,7 +5,7 @@
* nested inside text widgets. It also implements the "image"
* widget command for texts.
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * 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.
@@ -62,7 +62,7 @@ static void EmbImageDisplayProc _ANSI_ARGS_((
static int EmbImageLayoutProc _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr, TkTextSegment *segPtr,
int offset, int maxX, int maxChars,
- int noCharsYet, Tk_Uid wrapMode,
+ int noCharsYet, TkWrapMode wrapMode,
TkTextDispChunk *chunkPtr));
static void EmbImageProc _ANSI_ARGS_((ClientData clientData,
int x, int y, int width, int height,
@@ -221,7 +221,7 @@ TkTextImageCmd(textPtr, interp, argc, argv)
lineIndex = TkBTreeLineIndex(index.linePtr);
if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
lineIndex--;
- TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index);
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index);
}
/*
@@ -288,7 +288,7 @@ TkTextImageCmd(textPtr, interp, argc, argv)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message..
+ * returned, then the interp's result contains an error message..
*
* Side effects:
* Configuration information for the embedded image changes,
@@ -384,7 +384,7 @@ EmbImageConfigure(textPtr, eiPtr, argc, argv)
Tcl_DStringAppend(&newName,name, -1);
if (conflict) {
- char buf[10];
+ char buf[4 + TCL_INTEGER_SPACE];
sprintf(buf, "#%d",count+1);
Tcl_DStringAppend(&newName,buf, -1);
}
@@ -604,8 +604,8 @@ EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars,
* many characters. */
int noCharsYet; /* Non-zero means no characters have been
* assigned to this line yet. */
- Tk_Uid wrapMode; /* Wrap mode to use for line: tkTextCharUid,
- * tkTextNoneUid, or tkTextWordUid. */
+ 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
@@ -630,7 +630,7 @@ EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars,
height += 2*eiPtr->body.ei.padY;
}
if ((width > (maxX - chunkPtr->x))
- && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) {
+ && !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) {
return 0;
}
@@ -642,7 +642,7 @@ EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars,
chunkPtr->undisplayProc = (Tk_ChunkUndisplayProc *) NULL;
chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
chunkPtr->bboxProc = EmbImageBboxProc;
- chunkPtr->numChars = 1;
+ chunkPtr->numBytes = 1;
if (eiPtr->body.ei.align == ALIGN_BASELINE) {
chunkPtr->minAscent = height - eiPtr->body.ei.padY;
chunkPtr->minDescent = eiPtr->body.ei.padY;
@@ -857,7 +857,7 @@ TkTextImageIndex(textPtr, name, indexPtr)
eiPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
indexPtr->tree = textPtr->tree;
indexPtr->linePtr = eiPtr->body.ei.linePtr;
- indexPtr->charIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr);
+ indexPtr->byteIndex = TkTextSegToOffset(eiPtr, indexPtr->linePtr);
return 1;
}
@@ -893,6 +893,7 @@ EmbImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
index.tree = eiPtr->body.ei.textPtr->tree;
index.linePtr = eiPtr->body.ei.linePtr;
- index.charIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
+ index.byteIndex = TkTextSegToOffset(eiPtr, eiPtr->body.ei.linePtr);
TkTextChanged(eiPtr->body.ei.textPtr, &index, &index);
}
+
diff --git a/tk/generic/tkTextIndex.c b/tk/generic/tkTextIndex.c
index f2e9b0316ab..0b59b536c07 100644
--- a/tk/generic/tkTextIndex.c
+++ b/tk/generic/tkTextIndex.c
@@ -5,7 +5,7 @@
* text widgets.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -34,27 +34,118 @@ static char * StartEnd _ANSI_ARGS_(( char *string,
TkTextIndex *indexPtr));
/*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TkTextMakeIndex --
+ * TkTextMakeByteIndex --
*
- * Given a line index and a character index, look things up
- * in the B-tree and fill in a TkTextIndex structure.
+ * 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 charIndex (or the
- * closest existing character, if the specified one doesn't
- * exist), and indexPtr is returned as result.
+ * 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 *
-TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr)
+TkTextMakeByteIndex(tree, lineIndex, byteIndex, indexPtr)
+ TkTextBTree tree; /* Tree that lineIndex and charIndex refer
+ * to. */
+ int lineIndex; /* Index of desired line (0 means first
+ * line of text). */
+ int byteIndex; /* Byte index of desired character. */
+ TkTextIndex *indexPtr; /* Structure to fill in. */
+{
+ TkTextSegment *segPtr;
+ int index;
+ char *p, *start;
+ Tcl_UniChar ch;
+
+ indexPtr->tree = tree;
+ if (lineIndex < 0) {
+ lineIndex = 0;
+ byteIndex = 0;
+ }
+ if (byteIndex < 0) {
+ byteIndex = 0;
+ }
+ indexPtr->linePtr = TkBTreeFindLine(tree, lineIndex);
+ if (indexPtr->linePtr == NULL) {
+ indexPtr->linePtr = TkBTreeFindLine(tree, TkBTreeNumLines(tree));
+ byteIndex = 0;
+ }
+ if (byteIndex == 0) {
+ indexPtr->byteIndex = byteIndex;
+ return indexPtr;
+ }
+
+ /*
+ * Verify that the index is within the range of the line and points
+ * to a valid character boundary.
+ */
+
+ index = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segPtr == NULL) {
+ /*
+ * Use the index of the last character in the line. Since
+ * the last character on the line is guaranteed to be a '\n',
+ * we can back up a constant sizeof(char) bytes.
+ */
+
+ indexPtr->byteIndex = index - sizeof(char);
+ break;
+ }
+ if (index + segPtr->size > byteIndex) {
+ indexPtr->byteIndex = byteIndex;
+ if ((byteIndex > index) && (segPtr->typePtr == &tkTextCharType)) {
+ /*
+ * Prevent UTF-8 character from being split up by ensuring
+ * that byteIndex falls on a character boundary. If index
+ * falls in the middle of a UTF-8 character, it will be
+ * adjusted to the end of that UTF-8 character.
+ */
+
+ start = segPtr->body.chars + (byteIndex - index);
+ p = Tcl_UtfPrev(start, segPtr->body.chars);
+ p += Tcl_UtfToUniChar(p, &ch);
+ indexPtr->byteIndex += p - start;
+ }
+ break;
+ }
+ index += segPtr->size;
+ }
+ return indexPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextMakeCharIndex --
+ *
+ * Given a line index and a character index, look things up in the
+ * B-tree and fill in a TkTextIndex structure.
+ *
+ * Results:
+ * The structure at *indexPtr is filled in with information about the
+ * character at lineIndex and charIndex (or the closest existing
+ * character, if the specified one doesn't exist), and indexPtr is
+ * returned as result.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TkTextIndex *
+TkTextMakeCharIndex(tree, lineIndex, charIndex, indexPtr)
TkTextBTree tree; /* Tree that lineIndex and charIndex refer
* to. */
int lineIndex; /* Index of desired line (0 means first
@@ -63,7 +154,9 @@ TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr)
TkTextIndex *indexPtr; /* Structure to fill in. */
{
register TkTextSegment *segPtr;
- int index;
+ char *p, *start, *end;
+ int index, offset;
+ Tcl_UniChar ch;
indexPtr->tree = tree;
if (lineIndex < 0) {
@@ -84,53 +177,76 @@ TkTextMakeIndex(tree, lineIndex, charIndex, indexPtr)
* If not, just use the index of the last character in the line.
*/
- for (index = 0, segPtr = indexPtr->linePtr->segPtr; ;
- segPtr = segPtr->nextPtr) {
+ index = 0;
+ for (segPtr = indexPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
if (segPtr == NULL) {
- indexPtr->charIndex = index-1;
+ /*
+ * 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;
}
- index += segPtr->size;
- if (index > charIndex) {
- indexPtr->charIndex = charIndex;
- 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.
+ * 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.
+ * The return value is a pointer to the segment referred to by
+ * indexPtr; this will always be a segment with non-zero size. The
+ * variable at *offsetPtr is set to hold the integer offset within
+ * the segment of the character given by indexPtr.
*
* Side effects:
* None.
*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
TkTextSegment *
TkTextIndexToSeg(indexPtr, offsetPtr)
- TkTextIndex *indexPtr; /* Text index. */
- int *offsetPtr; /* Where to store offset within
- * segment, or NULL if offset isn't
- * wanted. */
+ CONST TkTextIndex *indexPtr;/* Text index. */
+ int *offsetPtr; /* Where to store offset within segment, or
+ * NULL if offset isn't wanted. */
{
- register TkTextSegment *segPtr;
+ TkTextSegment *segPtr;
int offset;
- for (offset = indexPtr->charIndex, segPtr = indexPtr->linePtr->segPtr;
+ for (offset = indexPtr->byteIndex, segPtr = indexPtr->linePtr->segPtr;
offset >= segPtr->size;
offset -= segPtr->size, segPtr = segPtr->nextPtr) {
/* Empty loop body. */
@@ -142,30 +258,29 @@ TkTextIndexToSeg(indexPtr, offsetPtr)
}
/*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TkTextSegToOffset --
*
- * Given a segment pointer and the line containing it, this
- * procedure returns the offset of the segment within its
- * line.
+ * 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.
+ * The return value is the offset (within its line) of the first
+ * character in segPtr.
*
* Side effects:
* None.
*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
TkTextSegToOffset(segPtr, linePtr)
- TkTextSegment *segPtr; /* Segment whose offset is desired. */
- TkTextLine *linePtr; /* Line containing segPtr. */
+ CONST TkTextSegment *segPtr;/* Segment whose offset is desired. */
+ CONST TkTextLine *linePtr; /* Line containing segPtr. */
{
- TkTextSegment *segPtr2;
+ CONST TkTextSegment *segPtr2;
int offset;
offset = 0;
@@ -177,23 +292,22 @@ TkTextSegToOffset(segPtr, linePtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TkTextGetIndex --
*
- * Given a string, return the line and character indices that
- * it describes.
+ * 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 interp->result.
+ * 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
@@ -203,8 +317,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr)
char *string; /* Textual description of position. */
TkTextIndex *indexPtr; /* Index structure to fill in. */
{
- register char *p;
- char *end, *endOfBase;
+ char *p, *end, *endOfBase;
Tcl_HashEntry *hPtr;
TkTextTag *tagPtr;
TkTextSearch search;
@@ -259,8 +372,8 @@ TkTextGetIndex(interp, textPtr, string, indexPtr)
goto tryxy;
}
tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
- TkTextMakeIndex(textPtr->tree, 0, 0, &first);
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0,
+ 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)) {
@@ -324,7 +437,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr)
}
endOfBase = end;
}
- TkTextMakeIndex(textPtr->tree, lineIndex, charIndex, indexPtr);
+ TkTextMakeCharIndex(textPtr->tree, lineIndex, charIndex, indexPtr);
goto gotBase;
}
@@ -353,7 +466,7 @@ TkTextGetIndex(interp, textPtr, string, indexPtr)
* Base position is end of text.
*/
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
0, indexPtr);
goto gotBase;
} else {
@@ -420,13 +533,12 @@ TkTextGetIndex(interp, textPtr, string, indexPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TkTextPrintIndex --
- *
*
- * This procedure generates a string description of an index,
- * suitable for reading in again later.
+ * This procedure generates a string description of an index, suitable
+ * for reading in again later.
*
* Results:
* The characters pointed to by string are modified.
@@ -434,49 +546,69 @@ TkTextGetIndex(interp, textPtr, string, indexPtr)
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
void
TkTextPrintIndex(indexPtr, string)
- TkTextIndex *indexPtr; /* Pointer to index. */
+ 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,
- indexPtr->charIndex);
+ charIndex);
}
/*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* TkTextIndexCmp --
*
- * Compare two indices to see which one is earlier in
- * the text.
+ * 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.
+ * The return value is 0 if index1Ptr and index2Ptr refer to the same
+ * position in the file, -1 if index1Ptr refers to an earlier position
+ * than index2Ptr, and 1 otherwise.
*
* Side effects:
* None.
*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
TkTextIndexCmp(index1Ptr, index2Ptr)
- TkTextIndex *index1Ptr; /* First index. */
- TkTextIndex *index2Ptr; /* Second index. */
+ CONST TkTextIndex *index1Ptr; /* First index. */
+ CONST TkTextIndex *index2Ptr; /* Second index. */
{
int line1, line2;
if (index1Ptr->linePtr == index2Ptr->linePtr) {
- if (index1Ptr->charIndex < index2Ptr->charIndex) {
+ if (index1Ptr->byteIndex < index2Ptr->byteIndex) {
return -1;
- } else if (index1Ptr->charIndex > index2Ptr->charIndex) {
+ } else if (index1Ptr->byteIndex > index2Ptr->byteIndex) {
return 1;
} else {
return 0;
@@ -494,23 +626,23 @@ TkTextIndexCmp(index1Ptr, index2Ptr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* ForwBack --
*
- * This procedure handles +/- modifiers for indices to adjust
- * the index forwards or backwards.
+ * 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.
+ * If the modifier in string is successfully parsed then the return
+ * value is the address of the first character after the modifier,
+ * and *indexPtr is updated to reflect the modifier. If there is a
+ * syntax error in the modifier then NULL is returned.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
static char *
@@ -550,7 +682,7 @@ ForwBack(string, indexPtr)
*/
units = p;
- while ((*p != 0) && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) {
+ while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '+') && (*p != '-')) {
p++;
}
length = p - units;
@@ -578,7 +710,18 @@ ForwBack(string, indexPtr)
lineIndex = 0;
}
}
- TkTextMakeIndex(indexPtr->tree, lineIndex, indexPtr->charIndex,
+ /*
+ * 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;
@@ -587,44 +730,42 @@ ForwBack(string, indexPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TkTextIndexForwChars --
+ * TkTextIndexForwBytes --
*
- * Given an index for a text widget, this procedure creates a
- * new index that points "count" characters ahead of the source
- * index.
+ * 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" characters
- * after srcPtr, or to the last character in the file if there aren't
- * "count" characters left in the file.
+ * *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.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
- /* ARGSUSED */
void
-TkTextIndexForwChars(srcPtr, count, dstPtr)
- TkTextIndex *srcPtr; /* Source index. */
- int count; /* How many characters forward to
- * move. May be negative. */
- TkTextIndex *dstPtr; /* Destination index: gets modified. */
+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 (count < 0) {
- TkTextIndexBackChars(srcPtr, -count, dstPtr);
+ if (byteCount < 0) {
+ TkTextIndexBackBytes(srcPtr, -byteCount, dstPtr);
return;
}
*dstPtr = *srcPtr;
- dstPtr->charIndex += count;
+ dstPtr->byteIndex += byteCount;
while (1) {
/*
* Compute the length of the current line.
@@ -641,13 +782,13 @@ TkTextIndexForwChars(srcPtr, count, dstPtr)
* Otherwise go on to the next line.
*/
- if (dstPtr->charIndex < lineLength) {
+ if (dstPtr->byteIndex < lineLength) {
return;
}
- dstPtr->charIndex -= lineLength;
+ dstPtr->byteIndex -= lineLength;
linePtr = TkBTreeNextLine(dstPtr->linePtr);
if (linePtr == NULL) {
- dstPtr->charIndex = lineLength - 1;
+ dstPtr->byteIndex = lineLength - 1;
return;
}
dstPtr->linePtr = linePtr;
@@ -655,44 +796,133 @@ TkTextIndexForwChars(srcPtr, count, dstPtr)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TkTextIndexBackChars --
+ * TkTextIndexForwChars --
*
- * Given an index for a text widget, this procedure creates a
- * new index that points "count" characters earlier than the
- * source index.
+ * 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
- * before srcPtr, or to the first character in the file if there aren't
- * "count" characters earlier than srcPtr.
+ * after srcPtr, or to the last character in the TkText if there
+ * aren't "count" characters left in the file.
*
* Side effects:
* None.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
void
-TkTextIndexBackChars(srcPtr, count, dstPtr)
- TkTextIndex *srcPtr; /* Source index. */
- int count; /* How many characters backward to
- * move. May be negative. */
- TkTextIndex *dstPtr; /* Destination index: gets modified. */
+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 (count < 0) {
- TkTextIndexForwChars(srcPtr, -count, dstPtr);
+ if (byteCount < 0) {
+ TkTextIndexForwBytes(srcPtr, -byteCount, dstPtr);
return;
}
*dstPtr = *srcPtr;
- dstPtr->charIndex -= count;
+ dstPtr->byteIndex -= byteCount;
lineIndex = -1;
- while (dstPtr->charIndex < 0) {
+ 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.
@@ -702,7 +932,7 @@ TkTextIndexBackChars(srcPtr, count, dstPtr)
lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
}
if (lineIndex == 0) {
- dstPtr->charIndex = 0;
+ dstPtr->byteIndex = 0;
return;
}
lineIndex--;
@@ -714,12 +944,128 @@ TkTextIndexBackChars(srcPtr, count, dstPtr)
for (segPtr = dstPtr->linePtr->segPtr; segPtr != NULL;
segPtr = segPtr->nextPtr) {
- dstPtr->charIndex += segPtr->size;
+ dstPtr->byteIndex += segPtr->size;
}
}
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TkTextIndexBackChars --
+ *
+ * Given an index for a text widget, this procedure creates a new
+ * index that points "count" characters earlier than the source index.
+ *
+ * Results:
+ * *dstPtr is modified to refer to the character "count" characters
+ * before srcPtr, or to the first character in the file if there
+ * aren't "count" characters earlier than srcPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkTextIndexBackChars(srcPtr, charCount, dstPtr)
+ CONST TkTextIndex *srcPtr; /* Source index. */
+ int charCount; /* How many characters backward to move.
+ * May be negative. */
+ TkTextIndex *dstPtr; /* Destination index: gets modified. */
+{
+ TkTextSegment *segPtr, *oldPtr;
+ int lineIndex, segSize;
+ char *p, *start, *end;
+
+ if (charCount <= 0) {
+ TkTextIndexForwChars(srcPtr, -charCount, dstPtr);
+ return;
+ }
+
+ *dstPtr = *srcPtr;
+
+ /*
+ * Find offset within seg that contains byteIndex.
+ * Move backward specified number of chars.
+ */
+
+ lineIndex = -1;
+
+ segSize = dstPtr->byteIndex;
+ for (segPtr = dstPtr->linePtr->segPtr; ; segPtr = segPtr->nextPtr) {
+ if (segSize <= segPtr->size) {
+ break;
+ }
+ segSize -= segPtr->size;
+ }
+ while (1) {
+ if (segPtr->typePtr == &tkTextCharType) {
+ start = segPtr->body.chars;
+ end = segPtr->body.chars + segSize;
+ for (p = end; ; p = Tcl_UtfPrev(p, start)) {
+ if (charCount == 0) {
+ dstPtr->byteIndex -= (end - p);
+ return;
+ }
+ if (p == start) {
+ break;
+ }
+ charCount--;
+ }
+ } else {
+ if (charCount <= segSize) {
+ dstPtr->byteIndex -= charCount;
+ return;
+ }
+ charCount -= segSize;
+ }
+ dstPtr->byteIndex -= segSize;
+
+ /*
+ * Move back into previous segment.
+ */
+
+ oldPtr = segPtr;
+ segPtr = dstPtr->linePtr->segPtr;
+ if (segPtr != oldPtr) {
+ for ( ; segPtr->nextPtr != oldPtr; segPtr = segPtr->nextPtr) {
+ /* Empty body. */
+ }
+ segSize = segPtr->size;
+ continue;
+ }
+
+ /*
+ * Move back to previous line.
+ */
+
+ if (lineIndex < 0) {
+ lineIndex = TkBTreeLineIndex(dstPtr->linePtr);
+ }
+ if (lineIndex == 0) {
+ dstPtr->byteIndex = 0;
+ return;
+ }
+ lineIndex--;
+ dstPtr->linePtr = TkBTreeFindLine(dstPtr->tree, lineIndex);
+
+ /*
+ * Compute the length of the line and add that to dstPtr->byteIndex.
+ */
+
+ oldPtr = dstPtr->linePtr->segPtr;
+ for (segPtr = oldPtr; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ dstPtr->byteIndex += segPtr->size;
+ oldPtr = segPtr;
+ }
+ segPtr = oldPtr;
+ segSize = segPtr->size;
+ }
+}
+
+/*
*----------------------------------------------------------------------
*
* StartEnd --
@@ -762,15 +1108,15 @@ StartEnd(string, indexPtr)
length = p-string;
if ((*string == 'l') && (strncmp(string, "lineend", length) == 0)
&& (length >= 5)) {
- indexPtr->charIndex = 0;
+ indexPtr->byteIndex = 0;
for (segPtr = indexPtr->linePtr->segPtr; segPtr != NULL;
segPtr = segPtr->nextPtr) {
- indexPtr->charIndex += segPtr->size;
+ indexPtr->byteIndex += segPtr->size;
}
- indexPtr->charIndex -= 1;
+ indexPtr->byteIndex -= sizeof(char);
} else if ((*string == 'l') && (strncmp(string, "linestart", length) == 0)
&& (length >= 5)) {
- indexPtr->charIndex = 0;
+ indexPtr->byteIndex = 0;
} else if ((*string == 'w') && (strncmp(string, "wordend", length) == 0)
&& (length >= 5)) {
int firstChar = 1;
@@ -791,7 +1137,7 @@ StartEnd(string, indexPtr)
firstChar = 0;
}
offset += 1;
- indexPtr->charIndex += 1;
+ indexPtr->byteIndex += sizeof(char);
if (offset >= segPtr->size) {
segPtr = TkTextIndexToSeg(indexPtr, &offset);
}
@@ -820,10 +1166,10 @@ StartEnd(string, indexPtr)
firstChar = 0;
}
offset -= 1;
- indexPtr->charIndex -= 1;
+ indexPtr->byteIndex -= sizeof(char);
if (offset < 0) {
- if (indexPtr->charIndex < 0) {
- indexPtr->charIndex = 0;
+ if (indexPtr->byteIndex < 0) {
+ indexPtr->byteIndex = 0;
goto done;
}
segPtr = TkTextIndexToSeg(indexPtr, &offset);
@@ -838,3 +1184,4 @@ StartEnd(string, indexPtr)
done:
return p;
}
+
diff --git a/tk/generic/tkTextMark.c b/tk/generic/tkTextMark.c
index 87f6079abab..c2e262a4c92 100644
--- a/tk/generic/tkTextMark.c
+++ b/tk/generic/tkTextMark.c
@@ -39,7 +39,7 @@ static void MarkCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
static int MarkLayoutProc _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr, TkTextSegment *segPtr,
int offset, int maxX, int maxChars,
- int noCharsYet, Tk_Uid wrapMode,
+ int noCharsYet, TkWrapMode wrapMode,
TkTextDispChunk *chunkPtr));
static int MarkFindNext _ANSI_ARGS_((Tcl_Interp *interp,
TkText *textPtr, char *markName));
@@ -134,9 +134,9 @@ TkTextMarkCmd(textPtr, interp, argc, argv)
markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
if (argc == 4) {
if (markPtr->typePtr == &tkTextRightMarkType) {
- interp->result = "right";
+ Tcl_SetResult(interp, "right", TCL_STATIC);
} else {
- interp->result = "left";
+ Tcl_SetResult(interp, "left", TCL_STATIC);
}
return TCL_OK;
}
@@ -319,10 +319,10 @@ TkTextMarkSegToIndex(textPtr, markPtr, indexPtr)
indexPtr->tree = textPtr->tree;
indexPtr->linePtr = markPtr->body.mark.linePtr;
- indexPtr->charIndex = 0;
+ indexPtr->byteIndex = 0;
for (segPtr = indexPtr->linePtr->segPtr; segPtr != markPtr;
segPtr = segPtr->nextPtr) {
- indexPtr->charIndex += segPtr->size;
+ indexPtr->byteIndex += segPtr->size;
}
}
@@ -454,7 +454,7 @@ MarkLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
* many characters. */
int noCharsYet; /* Non-zero means no characters have been
* assigned to this line yet. */
- Tk_Uid wrapMode; /* Not used. */
+ TkWrapMode wrapMode; /* Not used. */
register TkTextDispChunk *chunkPtr;
/* Structure to fill in with information
* about this chunk. The x field has already
@@ -468,7 +468,7 @@ MarkLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
chunkPtr->undisplayProc = InsertUndisplayProc;
chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
chunkPtr->bboxProc = (Tk_ChunkBboxProc *) NULL;
- chunkPtr->numChars = 0;
+ chunkPtr->numBytes = 0;
chunkPtr->minAscent = 0;
chunkPtr->minDescent = 0;
chunkPtr->minHeight = 0;
@@ -669,7 +669,7 @@ MarkFindNext(interp, textPtr, string)
return TCL_ERROR;
}
for (offset = 0, segPtr = index.linePtr->segPtr;
- segPtr != NULL && offset < index.charIndex;
+ segPtr != NULL && offset < index.byteIndex;
offset += segPtr->size, segPtr = segPtr->nextPtr) {
/* Empty loop body */ ;
}
@@ -692,7 +692,7 @@ MarkFindNext(interp, textPtr, string)
if (index.linePtr == (TkTextLine *) NULL) {
return TCL_OK;
}
- index.charIndex = 0;
+ index.byteIndex = 0;
segPtr = index.linePtr->segPtr;
}
}
@@ -742,7 +742,7 @@ MarkFindPrev(interp, textPtr, string)
return TCL_ERROR;
}
for (offset = 0, segPtr = index.linePtr->segPtr;
- segPtr != NULL && offset < index.charIndex;
+ segPtr != NULL && offset < index.byteIndex;
offset += segPtr->size, segPtr = segPtr->nextPtr) {
/* Empty loop body */ ;
}
@@ -773,3 +773,4 @@ MarkFindPrev(interp, textPtr, string)
segPtr = NULL;
}
}
+
diff --git a/tk/generic/tkTextTag.c b/tk/generic/tkTextTag.c
index e3ae2451683..f623b93026e 100644
--- a/tk/generic/tkTextTag.c
+++ b/tk/generic/tkTextTag.c
@@ -6,7 +6,7 @@
* related to tags.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -16,13 +16,9 @@
#include "default.h"
#include "tkPort.h"
-#include "tk.h"
+#include "tkInt.h"
#include "tkText.h"
-/*
- * Information used for parsing tag configuration information:
- */
-
static Tk_ConfigSpec tagConfigSpecs[] = {
{TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
(char *) NULL, Tk_Offset(TkTextTag, border), TK_CONFIG_NULL_OK},
@@ -30,7 +26,10 @@ static Tk_ConfigSpec tagConfigSpecs[] = {
(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_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,
@@ -63,9 +62,9 @@ static Tk_ConfigSpec tagConfigSpecs[] = {
{TK_CONFIG_STRING, "-underline", (char *) NULL, (char *) NULL,
(char *) NULL, Tk_Offset(TkTextTag, underlineString),
TK_CONFIG_NULL_OK},
- {TK_CONFIG_UID, "-wrap", (char *) NULL, (char *) NULL,
+ {TK_CONFIG_CUSTOM, "-wrap", (char *) NULL, (char *) NULL,
(char *) NULL, Tk_Offset(TkTextTag, wrapMode),
- TK_CONFIG_NULL_OK},
+ TK_CONFIG_NULL_OK, &textWrapModeOption},
{TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
(char *) NULL, 0, 0}
};
@@ -235,9 +234,22 @@ TkTextTagCmd(textPtr, interp, argc, argv)
command = Tk_GetBinding(interp, textPtr->bindingTable,
(ClientData) tagPtr, argv[4]);
if (command == NULL) {
- return TCL_ERROR;
+ char *string = Tcl_GetStringResult(interp);
+
+ /*
+ * Ignore missing binding errors. This is a special hack
+ * that relies on the error message returned by FindSequence
+ * in tkBind.c.
+ */
+
+ if (string[0] != '\0') {
+ return TCL_ERROR;
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ } else {
+ Tcl_SetResult(interp, command, TCL_STATIC);
}
- interp->result = command;
} else {
Tk_GetAllBindings(interp, textPtr->bindingTable,
(ClientData) tagPtr);
@@ -378,14 +390,11 @@ TkTextTagCmd(textPtr, interp, argc, argv)
return TCL_ERROR;
}
}
- if ((tagPtr->wrapMode != NULL)
- && (tagPtr->wrapMode != tkTextCharUid)
- && (tagPtr->wrapMode != tkTextNoneUid)
- && (tagPtr->wrapMode != tkTextWordUid)) {
- Tcl_AppendResult(interp, "bad wrap mode \"", tagPtr->wrapMode,
- "\": must be char, none, or word", (char *) NULL);
- tagPtr->wrapMode = NULL;
- return TCL_ERROR;
+ if (tagPtr->elideString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->elideString,
+ &tagPtr->elide) != TCL_OK) {
+ return TCL_ERROR;
+ }
}
/*
@@ -419,7 +428,8 @@ TkTextTagCmd(textPtr, interp, argc, argv)
|| (tagPtr->spacing3String != NULL)
|| (tagPtr->tabString != NULL)
|| (tagPtr->underlineString != NULL)
- || (tagPtr->wrapMode != NULL)) {
+ || (tagPtr->elideString != NULL)
+ || (tagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
tagPtr->affectsDisplay = 1;
}
TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
@@ -448,10 +458,10 @@ TkTextTagCmd(textPtr, interp, argc, argv)
TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
(TkTextIndex *) NULL, tagPtr, 1);
}
- TkBTreeTag(TkTextMakeIndex(textPtr->tree, 0, 0, &first),
- TkTextMakeIndex(textPtr->tree,
- TkBTreeNumLines(textPtr->tree), 0, &last),
- tagPtr, 0);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ 0, &last),
+ TkBTreeTag(&first, &last, tagPtr, 0);
Tcl_DeleteHashEntry(hPtr);
if (textPtr->bindingTable != NULL) {
Tk_DeleteAllBindings(textPtr->bindingTable,
@@ -552,7 +562,7 @@ TkTextTagCmd(textPtr, interp, argc, argv)
if (TkTextGetIndex(interp, textPtr, argv[4], &index1) != TCL_OK) {
return TCL_ERROR;
}
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
0, &last);
if (argc == 5) {
index2 = last;
@@ -582,7 +592,7 @@ TkTextTagCmd(textPtr, interp, argc, argv)
* skip to the end of this tagged range.
*/
- for (segPtr = index1.linePtr->segPtr, offset = index1.charIndex;
+ for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex;
offset >= 0;
offset -= segPtr->size, segPtr = segPtr->nextPtr) {
if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
@@ -631,7 +641,7 @@ TkTextTagCmd(textPtr, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 5) {
- TkTextMakeIndex(textPtr->tree, 0, 0, &index2);
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &index2);
} else if (TkTextGetIndex(interp, textPtr, argv[5], &index2)
!= TCL_OK) {
return TCL_ERROR;
@@ -651,7 +661,7 @@ TkTextTagCmd(textPtr, interp, argc, argv)
}
if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
TkTextPrintIndex(&tSearch.curIndex, position1);
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
0, &last);
TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
TkBTreeNextTag(&tSearch);
@@ -711,8 +721,8 @@ TkTextTagCmd(textPtr, interp, argc, argv)
if (tagPtr == NULL) {
return TCL_OK;
}
- TkTextMakeIndex(textPtr->tree, 0, 0, &first);
- TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree),
0, &last);
TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
if (TkBTreeCharTagged(&first, tagPtr)) {
@@ -811,7 +821,9 @@ TkTextCreateTag(textPtr, tagName)
tagPtr->tabArrayPtr = NULL;
tagPtr->underlineString = NULL;
tagPtr->underline = 0;
- tagPtr->wrapMode = NULL;
+ tagPtr->elideString = NULL;
+ tagPtr->elide = 0;
+ tagPtr->wrapMode = TEXT_WRAPMODE_NULL;
tagPtr->affectsDisplay = 0;
textPtr->numTags++;
Tcl_SetHashValue(hPtr, tagPtr);
@@ -828,7 +840,7 @@ TkTextCreateTag(textPtr, tagName)
* Results:
* If tagName is defined in textPtr, a pointer to its TkTextTag
* structure is returned. Otherwise NULL is returned and an
- * error message is recorded in interp->result unless interp
+ * error message is recorded in the interp's result unless interp
* is NULL.
*
* Side effects:
@@ -1374,3 +1386,4 @@ TkTextPickCurrent(textPtr, eventPtr)
ckfree((char *) copyArrayPtr);
}
}
+
diff --git a/tk/generic/tkTextWind.c b/tk/generic/tkTextWind.c
index cc9f7ba0820..9624403cf2c 100644
--- a/tk/generic/tkTextWind.c
+++ b/tk/generic/tkTextWind.c
@@ -6,7 +6,7 @@
* widget command for texts.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -81,7 +81,7 @@ static void EmbWinDisplayProc _ANSI_ARGS_((
static int EmbWinLayoutProc _ANSI_ARGS_((TkText *textPtr,
TkTextIndex *indexPtr, TkTextSegment *segPtr,
int offset, int maxX, int maxChars,
- int noCharsYet, Tk_Uid wrapMode,
+ int noCharsYet, TkWrapMode wrapMode,
TkTextDispChunk *chunkPtr));
static void EmbWinStructureProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
@@ -244,7 +244,7 @@ TkTextWindowCmd(textPtr, interp, argc, argv)
lineIndex = TkBTreeLineIndex(index.linePtr);
if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
lineIndex--;
- TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, &index);
+ TkTextMakeByteIndex(textPtr->tree, lineIndex, 1000000, &index);
}
/*
@@ -311,7 +311,7 @@ TkTextWindowCmd(textPtr, interp, argc, argv)
*
* Results:
* The return value is a standard Tcl result. If TCL_ERROR is
- * returned, then interp->result contains an error message..
+ * returned, then the interp's result contains an error message..
*
* Side effects:
* Configuration information for the embedded window changes,
@@ -541,7 +541,7 @@ EmbWinStructureProc(clientData, eventPtr)
ewPtr->body.ew.tkwin = NULL;
index.tree = ewPtr->body.ew.textPtr->tree;
index.linePtr = ewPtr->body.ew.linePtr;
- index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}
@@ -575,7 +575,7 @@ EmbWinRequestProc(clientData, tkwin)
index.tree = ewPtr->body.ew.textPtr->tree;
index.linePtr = ewPtr->body.ew.linePtr;
- index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}
@@ -620,7 +620,7 @@ EmbWinLostSlaveProc(clientData, tkwin)
ewPtr->body.ew.tkwin = NULL;
index.tree = ewPtr->body.ew.textPtr->tree;
index.linePtr = ewPtr->body.ew.linePtr;
- index.charIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
+ index.byteIndex = TkTextSegToOffset(ewPtr, ewPtr->body.ew.linePtr);
TkTextChanged(ewPtr->body.ew.textPtr, &index, &index);
}
@@ -744,8 +744,8 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars,
* many characters. */
int noCharsYet; /* Non-zero means no characters have been
* assigned to this line yet. */
- Tk_Uid wrapMode; /* Wrap mode to use for line: tkTextCharUid,
- * tkTextNoneUid, or tkTextWordUid. */
+ 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
@@ -778,7 +778,7 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars,
goto gotWindow;
}
Tcl_DStringInit(&name);
- Tcl_DStringAppend(&name, textPtr->interp->result, -1);
+ 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);
@@ -835,7 +835,7 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars,
height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
}
if ((width > (maxX - chunkPtr->x))
- && !noCharsYet && (textPtr->wrapMode != tkTextNoneUid)) {
+ && !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) {
return 0;
}
@@ -847,7 +847,7 @@ EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars,
chunkPtr->undisplayProc = EmbWinUndisplayProc;
chunkPtr->measureProc = (Tk_ChunkMeasureProc *) NULL;
chunkPtr->bboxProc = EmbWinBboxProc;
- chunkPtr->numChars = 1;
+ chunkPtr->numBytes = 1;
if (ewPtr->body.ew.align == ALIGN_BASELINE) {
chunkPtr->minAscent = height - ewPtr->body.ew.padY;
chunkPtr->minDescent = ewPtr->body.ew.padY;
@@ -1171,6 +1171,7 @@ TkTextWindowIndex(textPtr, name, indexPtr)
ewPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
indexPtr->tree = textPtr->tree;
indexPtr->linePtr = ewPtr->body.ew.linePtr;
- indexPtr->charIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
+ indexPtr->byteIndex = TkTextSegToOffset(ewPtr, indexPtr->linePtr);
return 1;
}
+
diff --git a/tk/generic/tkTrig.c b/tk/generic/tkTrig.c
index cf4b8b80c0b..b9f0628242a 100644
--- a/tk/generic/tkTrig.c
+++ b/tk/generic/tkTrig.c
@@ -7,7 +7,7 @@
* used by canvases.
*
* Copyright (c) 1992-1994 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
+ * 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.
@@ -1066,6 +1066,14 @@ TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints)
* 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])) {
@@ -1195,7 +1203,7 @@ TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints)
*
* Results:
* None. Postscript commands to generate the path are appended
- * to interp->result.
+ * to the interp's result.
*
* Side effects:
* None.
@@ -1465,3 +1473,4 @@ TkGetButtPoints(p1, p2, width, project, m1, m2)
}
}
}
+
diff --git a/tk/generic/tkUtil.c b/tk/generic/tkUtil.c
index 407837438e6..cbb49e6d8bb 100644
--- a/tk/generic/tkUtil.c
+++ b/tk/generic/tkUtil.c
@@ -6,7 +6,7 @@
* a focus highlight.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -16,6 +16,501 @@
#include "tkInt.h"
#include "tkPort.h"
+
+/*
+ * The structure below defines the implementation of the "statekey"
+ * Tcl object, used for quickly finding a mapping in a TkStateMap.
+ */
+
+static Tcl_ObjType stateKeyType = {
+ "statekey", /* name */
+ (Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
+ (Tcl_SetFromAnyProc *) NULL /* setFromAnyProc */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+}
/*
*----------------------------------------------------------------------
@@ -50,22 +545,6 @@ TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding)
{
XRectangle rects[4];
- /*
- * On the Macintosh the highlight ring needs to be "padded"
- * out by one pixel. Unfortunantly, none of the Tk widgets
- * had a notion of padding between the focus ring and the
- * widget. So we add this padding here. This introduces
- * two things to worry about:
- *
- * 1) The widget must draw the background color covering
- * the focus ring area before calling Tk_DrawFocus.
- * 2) It is impossible to draw a focus ring of width 1.
- * (For the Macintosh Look & Feel use width of 3)
- */
-#ifdef MAC_TCL
- width--;
-#endif
-
rects[0].x = padding;
rects[0].y = padding;
rects[0].width = Tk_Width(tkwin) - (2 * padding);
@@ -93,6 +572,12 @@ TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding)
* 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.
*
@@ -132,7 +617,7 @@ Tk_DrawFocusHighlight(tkwin, gc, width, drawable)
* took. If TK_SCROLL_MOVETO, *dblPtr is filled in with the
* desired position; if TK_SCROLL_PAGES or TK_SCROLL_UNITS,
* *intPtr is filled in with the number of lines to move (may be
- * negative); if TK_SCROLL_ERROR, interp->result contains an
+ * negative); if TK_SCROLL_ERROR, the interp's result contains an
* error message.
*
* Side effects:
@@ -197,6 +682,85 @@ Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr)
}
/*
+ *----------------------------------------------------------------------
+ *
+ * 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 --
@@ -310,7 +874,7 @@ TkFindStateString(mapPtr, numKey)
* Returns the numKey associated with the last element (the NULL
* string one) in the table if strKey was not equal to any of the
* string keys in the table. In that case, an error message is
- * also left in interp->result (if interp is not NULL).
+ * also left in the interp's result (if interp is not NULL).
*
* Side effects.
* None.
@@ -319,30 +883,73 @@ TkFindStateString(mapPtr, numKey)
*/
int
-TkFindStateNum(interp, field, mapPtr, strKey)
+TkFindStateNum(interp, option, mapPtr, strKey)
Tcl_Interp *interp; /* Interp for error reporting. */
- CONST char *field; /* String to use when constructing error. */
+ 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;
- if (mapPtr->strKey == NULL) {
- panic("TkFindStateNum: no choices in lookup table");
+ for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
+ if (strcmp(strKey, mPtr->strKey) == 0) {
+ return mPtr->numKey;
+ }
}
+ if (interp != NULL) {
+ mPtr = mapPtr;
+ Tcl_AppendResult(interp, "bad ", option, " value \"", strKey,
+ "\": must be ", mPtr->strKey, (char *) NULL);
+ for (mPtr++; mPtr->strKey != NULL; mPtr++) {
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, (char *) NULL);
+ }
+ }
+ return mPtr->numKey;
+}
+int
+TkFindStateNumObj(interp, optionPtr, mapPtr, keyPtr)
+ Tcl_Interp *interp; /* Interp for error reporting. */
+ Tcl_Obj *optionPtr; /* String to use when constructing error. */
+ CONST TkStateMap *mapPtr; /* Lookup table. */
+ Tcl_Obj *keyPtr; /* String key to find in lookup table. */
+{
+ CONST TkStateMap *mPtr;
+ CONST char *key;
+ CONST Tcl_ObjType *typePtr;
+
+ if ((keyPtr->typePtr == &stateKeyType)
+ && (keyPtr->internalRep.twoPtrValue.ptr1 == (VOID *) mapPtr)) {
+ return (int) keyPtr->internalRep.twoPtrValue.ptr2;
+ }
+
+ key = Tcl_GetStringFromObj(keyPtr, NULL);
for (mPtr = mapPtr; mPtr->strKey != NULL; mPtr++) {
- if (strcmp(strKey, mPtr->strKey) == 0) {
+ if (strcmp(key, mPtr->strKey) == 0) {
+ typePtr = keyPtr->typePtr;
+ if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+ (*typePtr->freeIntRepProc)(keyPtr);
+ }
+ keyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mapPtr;
+ keyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) mPtr->numKey;
+ keyPtr->typePtr = &stateKeyType;
return mPtr->numKey;
}
}
if (interp != NULL) {
mPtr = mapPtr;
- Tcl_AppendResult(interp, "bad ", field, " value \"", strKey,
+ 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->strKey, (char *) NULL);
+ Tcl_AppendResult(interp,
+ ((mPtr[1].strKey != NULL) ? ", " : ", or "),
+ mPtr->strKey, (char *) NULL);
}
}
return mPtr->numKey;
}
+
+
diff --git a/tk/generic/tkVisual.c b/tk/generic/tkVisual.c
index 4b9457814a2..a2d717a119d 100644
--- a/tk/generic/tkVisual.c
+++ b/tk/generic/tkVisual.c
@@ -6,7 +6,7 @@
* prototype implementation by Paul Mackerras.
*
* Copyright (c) 1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -74,7 +74,7 @@ struct TkColormap {
* Results:
* The return value is normally a pointer to a visual. If an
* error occurred in looking up the visual, NULL is returned and
- * an error message is left in interp->result. The depth of the
+ * 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
@@ -243,7 +243,8 @@ Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr)
visInfoList = XGetVisualInfo(Tk_Display(tkwin), mask, &template,
&numVisuals);
if (visInfoList == NULL) {
- interp->result = "couldn't find an appropriate visual";
+ Tcl_SetResult(interp, "couldn't find an appropriate visual",
+ TCL_STATIC);
return NULL;
}
@@ -352,7 +353,7 @@ Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr)
* Results:
* The return value is normally the X resource identifier for the
* colormap. If an error occurs, None is returned and an error
- * message is placed in interp->result.
+ * message is placed in the interp's result.
*
* Side effects:
* A reference count is incremented for the colormap, so
@@ -538,3 +539,4 @@ Tk_PreserveColormap(display, colormap)
}
}
}
+
diff --git a/tk/generic/tkWindow.c b/tk/generic/tkWindow.c
index 2da31fd6e2d..5f3a8a0c517 100644
--- a/tk/generic/tkWindow.c
+++ b/tk/generic/tkWindow.c
@@ -18,38 +18,30 @@
#include "tkPort.h"
#include "tkInt.h"
-/*
- * Count of number of main windows currently open in this process.
- */
-
-static int numMainWindows;
-
-/*
- * First in list of all main windows managed by this process.
- */
-
-TkMainInfo *tkMainWindowList = NULL;
-
-/*
- * List of all displays currently in use.
- */
-
-TkDisplay *tkDisplayList = NULL;
+#if !defined(__WIN32__) && !defined(MAC_TCL)
+#include "tkUnixInt.h"
+#endif
-/*
- * Have statics in this module been initialized?
- */
-static int initialized = 0;
+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 variables below hold several uid's that are used in many places
- * in the toolkit.
+/*
+ * The Mutex below is used to lock access to the Tk_Uid structs above.
*/
-Tk_Uid tkDisabledUid = NULL;
-Tk_Uid tkActiveUid = NULL;
-Tk_Uid tkNormalUid = NULL;
+TCL_DECLARE_MUTEX(windowMutex)
/*
* Default values for "changes" and "atts" fields of TkWindows. Note
@@ -94,6 +86,10 @@ typedef struct {
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[] = {
@@ -101,62 +97,67 @@ static TkCmd commands[] = {
* Commands that are part of the intrinsics:
*/
- {"bell", NULL, Tk_BellObjCmd, 0},
- {"bind", Tk_BindCmd, NULL, 1},
- {"bindtags", Tk_BindtagsCmd, NULL, 1},
- {"clipboard", Tk_ClipboardCmd, NULL, 0},
- {"destroy", Tk_DestroyCmd, NULL, 1},
- {"event", Tk_EventCmd, NULL, 1},
- {"focus", Tk_FocusCmd, NULL, 1},
- {"font", NULL, Tk_FontObjCmd, 1},
- {"grab", Tk_GrabCmd, NULL, 0},
- {"grid", Tk_GridCmd, NULL, 1},
- {"image", NULL, Tk_ImageCmd, 1},
- {"lower", Tk_LowerCmd, NULL, 1},
- {"option", Tk_OptionCmd, NULL, 1},
- {"pack", Tk_PackCmd, NULL, 1},
- {"place", Tk_PlaceCmd, NULL, 1},
- {"raise", Tk_RaiseCmd, NULL, 1},
- {"selection", Tk_SelectionCmd, NULL, 0},
- {"tk", NULL, Tk_TkObjCmd, 0},
- {"tkwait", Tk_TkwaitCmd, NULL, 1},
- {"tk_chooseColor", Tk_ChooseColorCmd, NULL, 0},
- {"tk_getOpenFile", Tk_GetOpenFileCmd, NULL, 0},
- {"tk_getSaveFile", Tk_GetSaveFileCmd, NULL, 0},
- {"tk_messageBox", Tk_MessageBoxCmd, NULL, 0},
- {"update", Tk_UpdateCmd, NULL, 1},
- {"winfo", NULL, Tk_WinfoObjCmd, 1},
- {"wm", Tk_WmCmd, NULL, 0},
+ {"bell", NULL, Tk_BellObjCmd, 0, 1},
+ {"bind", Tk_BindCmd, NULL, 1, 1},
+ {"bindtags", Tk_BindtagsCmd, NULL, 1, 1},
+ {"clipboard", Tk_ClipboardCmd, NULL, 0, 1},
+ {"destroy", NULL, Tk_DestroyObjCmd, 1, 1},
+ {"event", NULL, Tk_EventObjCmd, 1, 1},
+ {"focus", NULL, Tk_FocusObjCmd, 1, 1},
+ {"font", NULL, Tk_FontObjCmd, 1, 1},
+ {"grab", Tk_GrabCmd, NULL, 0, 1},
+ {"grid", Tk_GridCmd, NULL, 1, 1},
+ {"image", NULL, Tk_ImageObjCmd, 1, 1},
+ {"lower", NULL, Tk_LowerObjCmd, 1, 1},
+ {"option", NULL, Tk_OptionObjCmd, 1, 1},
+ {"pack", Tk_PackCmd, NULL, 1, 1},
+ {"place", Tk_PlaceCmd, NULL, 1, 1},
+ {"raise", NULL, Tk_RaiseObjCmd, 1, 1},
+ {"selection", Tk_SelectionCmd, NULL, 0, 1},
+ {"tk", NULL, Tk_TkObjCmd, 0, 1},
+ {"tkwait", Tk_TkwaitCmd, NULL, 1, 1},
+#if defined(__WIN32__) || defined(MAC_TCL)
+ {"tk_chooseColor", NULL, Tk_ChooseColorObjCmd, 0, 1},
+ {"tk_chooseDirectory", NULL, Tk_ChooseDirectoryObjCmd, 0, 1},
+ {"tk_getOpenFile", NULL, Tk_GetOpenFileObjCmd, 0, 1},
+ {"tk_getSaveFile", NULL, Tk_GetSaveFileObjCmd, 0, 1},
+#endif
+#ifdef __WIN32__
+ {"tk_messageBox", NULL, Tk_MessageBoxObjCmd, 0, 1},
+#endif
+ {"update", NULL, Tk_UpdateObjCmd, 1, 1},
+ {"winfo", NULL, Tk_WinfoObjCmd, 1, 1},
+ {"wm", Tk_WmCmd, NULL, 0, 1},
/*
* Widget class commands.
*/
- {"button", Tk_ButtonCmd, NULL, 1},
- {"canvas", Tk_CanvasCmd, NULL, 1},
- {"checkbutton", Tk_CheckbuttonCmd, NULL, 1},
- {"entry", Tk_EntryCmd, NULL, 1},
- {"frame", Tk_FrameCmd, NULL, 1},
- {"label", Tk_LabelCmd, NULL, 1},
- {"listbox", Tk_ListboxCmd, NULL, 1},
- {"menu", Tk_MenuCmd, NULL, 0},
- {"menubutton", Tk_MenubuttonCmd, NULL, 1},
- {"message", Tk_MessageCmd, NULL, 1},
- {"radiobutton", Tk_RadiobuttonCmd, NULL, 1},
- {"scale", Tk_ScaleCmd, NULL, 1},
- {"scrollbar", Tk_ScrollbarCmd, NULL, 1},
- {"text", Tk_TextCmd, NULL, 1},
- {"toplevel", Tk_ToplevelCmd, NULL, 0},
+
+ {"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, 1},
+ {"label", NULL, Tk_LabelObjCmd, 1, 0},
+ {"listbox", NULL, Tk_ListboxObjCmd, 1, 0},
+ {"menubutton", NULL, Tk_MenubuttonObjCmd, 1, 0},
+ {"message", Tk_MessageCmd, NULL, 1, 1},
+ {"radiobutton", NULL, Tk_RadiobuttonObjCmd, 1, 0},
+ {"scale", NULL, Tk_ScaleObjCmd, 1, 0},
+ {"scrollbar", Tk_ScrollbarCmd, NULL, 1, 1},
+ {"text", Tk_TextCmd, NULL, 1, 1},
+ {"toplevel", NULL, Tk_ToplevelObjCmd, 0, 1},
/*
* Misc.
*/
#ifdef MAC_TCL
- {"unsupported1", TkUnsupported1Cmd, NULL, 1},
+ {"unsupported1", TkUnsupported1Cmd, NULL, 1, 1},
#endif
{(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0}
};
-
+
/*
* The variables and table below are used to parse arguments from
* the "argv" variable in Tk_Init.
@@ -221,7 +222,7 @@ static void UnlinkWindow _ANSI_ARGS_((TkWindow *winPtr));
* The return value is a token for the new window, or NULL if
* an error prevented the new window from being created. If
* NULL is returned, an error message will be left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* A new window structure is allocated locally. An X
@@ -249,12 +250,11 @@ CreateTopLevelWindow(interp, parent, name, screenName)
register TkWindow *winPtr;
register TkDisplay *dispPtr;
int screenId;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (!initialized) {
- initialized = 1;
- tkActiveUid = Tk_GetUid("active");
- tkDisabledUid = Tk_GetUid("disabled");
- tkNormalUid = Tk_GetUid("normal");
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
/*
* Create built-in image types.
@@ -268,7 +268,7 @@ CreateTopLevelWindow(interp, parent, name, screenName)
*/
Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
- Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
+ Tk_CreateOldPhotoImageFormat(&tkImgFmtPPM);
/*
* Create exit handler to delete all windows when the application
@@ -331,7 +331,7 @@ CreateTopLevelWindow(interp, parent, name, screenName)
* Results:
* The return value is a pointer to information about the display,
* or NULL if the display couldn't be opened. In this case, an
- * error message is left in interp->result. The location at
+ * error message is left in the interp's result. The location at
* *screenPtr is overwritten with the screen number parsed from
* screenName.
*
@@ -354,6 +354,8 @@ GetScreen(interp, screenName, screenPtr)
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
@@ -364,8 +366,9 @@ GetScreen(interp, screenName, screenPtr)
screenName = TkGetDefaultScreenName(interp, screenName);
if (screenName == NULL) {
- interp->result =
- "no display name and no $DISPLAY environment variable";
+ Tcl_SetResult(interp,
+ "no display name and no $DISPLAY environment variable",
+ TCL_STATIC);
return (TkDisplay *) NULL;
}
length = strlen(screenName);
@@ -384,7 +387,7 @@ GetScreen(interp, screenName, screenPtr)
* then open a new connection.
*/
- for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
if (dispPtr == NULL) {
dispPtr = TkpOpenDisplay(screenName);
if (dispPtr == NULL) {
@@ -392,29 +395,35 @@ GetScreen(interp, screenName, screenPtr)
screenName, "\"", (char *) NULL);
return (TkDisplay *) NULL;
}
- dispPtr->nextPtr = tkDisplayList;
+ dispPtr->nextPtr = TkGetDisplayList();
dispPtr->name = (char *) ckalloc((unsigned) (length+1));
dispPtr->lastEventTime = CurrentTime;
- strncpy(dispPtr->name, screenName, length);
- dispPtr->name[length] = '\0';
+ dispPtr->borderInit = 0;
+ dispPtr->atomInit = 0;
dispPtr->bindInfoStale = 1;
dispPtr->modeModMask = 0;
dispPtr->metaModMask = 0;
dispPtr->altModMask = 0;
dispPtr->numModKeyCodes = 0;
dispPtr->modKeyCodes = NULL;
- OpenIM(dispPtr);
+ dispPtr->bitmapInit = 0;
+ dispPtr->bitmapAutoNumber = 0;
+ dispPtr->numIdSearches = 0;
+ dispPtr->numSlowSearches = 0;
+ dispPtr->colorInit = 0;
+ dispPtr->stressPtr = NULL;
+ dispPtr->cursorInit = 0;
+ dispPtr->cursorString[0] = '\0';
+ dispPtr->cursorFont = None;
dispPtr->errorPtr = NULL;
dispPtr->deleteCount = 0;
- dispPtr->commTkwin = NULL;
- dispPtr->selectionInfoPtr = NULL;
- dispPtr->multipleAtom = None;
- dispPtr->clipWindow = NULL;
- dispPtr->clipboardActive = 0;
- dispPtr->clipboardAppPtr = NULL;
- dispPtr->clipTargetPtr = NULL;
- dispPtr->atomInit = 0;
- dispPtr->cursorFont = None;
+ dispPtr->delayedMotionPtr = NULL;
+ dispPtr->focusDebug = 0;
+ dispPtr->implicitWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ dispPtr->gcInit = 0;
+ dispPtr->geomInit = 0;
+ dispPtr->uidInit = 0;
dispPtr->grabWinPtr = NULL;
dispPtr->eventualGrabWinPtr = NULL;
dispPtr->buttonWinPtr = NULL;
@@ -422,18 +431,38 @@ GetScreen(interp, screenName, screenPtr)
dispPtr->firstGrabEventPtr = NULL;
dispPtr->lastGrabEventPtr = NULL;
dispPtr->grabFlags = 0;
- TkInitXId(dispPtr);
+ dispPtr->mouseButtonState = 0;
+ dispPtr->warpInProgress = 0;
+ dispPtr->warpWindow = None;
+ dispPtr->warpX = 0;
+ dispPtr->warpY = 0;
+ dispPtr->gridInit = 0;
+ dispPtr->imageId = 0;
+ dispPtr->packInit = 0;
+ dispPtr->placeInit = 0;
+ dispPtr->selectionInfoPtr = NULL;
+ dispPtr->multipleAtom = None;
+ dispPtr->clipWindow = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->commTkwin = NULL;
+ dispPtr->wmTracing = 0;
+ dispPtr->firstWmPtr = NULL;
+ dispPtr->foregroundWmPtr = NULL;
dispPtr->destroyCount = 0;
dispPtr->lastDestroyRequest = 0;
dispPtr->cmapPtr = NULL;
- dispPtr->implicitWinPtr = NULL;
- dispPtr->focusPtr = NULL;
- dispPtr->stressPtr = NULL;
- dispPtr->delayedMotionPtr = NULL;
Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
+
dispPtr->refCount = 0;
-
- tkDisplayList = dispPtr;
+ strncpy(dispPtr->name, screenName, length);
+ dispPtr->name[length] = '\0';
+ dispPtr->useInputMethods = 0;
+ OpenIM(dispPtr);
+ TkInitXId(dispPtr);
+
+ tsdPtr->displayList = dispPtr;
break;
}
if ((strncmp(dispPtr->name, screenName, length) == 0)
@@ -442,7 +471,10 @@ GetScreen(interp, screenName, screenPtr)
}
}
if (screenId >= ScreenCount(dispPtr->display)) {
- sprintf(interp->result, "bad screen number \"%d\"", screenId);
+ char buf[32 + TCL_INTEGER_SPACE];
+
+ sprintf(buf, "bad screen number \"%d\"", screenId);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return (TkDisplay *) NULL;
}
*screenPtr = screenId;
@@ -472,8 +504,10 @@ TkGetDisplay(display)
Display *display; /* X's display pointer */
{
TkDisplay *dispPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
if (dispPtr->display == display) {
break;
@@ -485,6 +519,58 @@ TkGetDisplay(display)
/*
*--------------------------------------------------------------
*
+ * 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.
@@ -675,7 +761,7 @@ NameWindow(interp, winPtr, parentPtr, name)
* The return value is a token for the new window, or NULL if
* an error prevented the new window from being created. If
* NULL is returned, an error message will be left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* A new window structure is allocated locally; "interp" is
@@ -703,6 +789,9 @@ TkCreateMainWindow(interp, screenName, baseName)
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
@@ -734,6 +823,7 @@ TkCreateMainWindow(interp, screenName, baseName)
mainPtr->refCount = 1;
mainPtr->interp = interp;
Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);
+ TkEventInit();
TkBindInit(mainPtr);
TkFontPkgInit(mainPtr);
mainPtr->tlFocusPtr = NULL;
@@ -745,8 +835,8 @@ TkCreateMainWindow(interp, screenName, baseName)
TCL_LINK_BOOLEAN) != TCL_OK) {
Tcl_ResetResult(interp);
}
- mainPtr->nextPtr = tkMainWindowList;
- tkMainWindowList = mainPtr;
+ mainPtr->nextPtr = tsdPtr->mainWindowList;
+ tsdPtr->mainWindowList = mainPtr;
winPtr->mainPtr = mainPtr;
hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
Tcl_SetHashValue(hPtr, winPtr);
@@ -774,12 +864,17 @@ TkCreateMainWindow(interp, screenName, baseName)
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) tkwin, (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ clientData, (void (*) _ANSI_ARGS_((ClientData))) NULL);
} else {
Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
- (ClientData) tkwin, NULL);
+ clientData, NULL);
}
if (isSafe) {
if (!(cmdPtr->isSafe)) {
@@ -788,6 +883,8 @@ TkCreateMainWindow(interp, screenName, baseName)
}
}
+ TkCreateMenuCmd(interp);
+
/*
* Set variables for the intepreter.
*/
@@ -795,7 +892,7 @@ TkCreateMainWindow(interp, screenName, baseName)
Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);
- numMainWindows++;
+ tsdPtr->numMainWindows++;
return tkwin;
}
@@ -811,7 +908,7 @@ TkCreateMainWindow(interp, screenName, baseName)
* The return value is a token for the new window. This
* is not the same as X's token for the window. If an error
* occurred in creating the window (e.g. no such display or
- * screen), then an error message is left in interp->result and
+ * screen), then an error message is left in the interp's result and
* NULL is returned.
*
* Side effects:
@@ -825,7 +922,7 @@ TkCreateMainWindow(interp, screenName, baseName)
Tk_Window
Tk_CreateWindow(interp, parent, name, screenName)
Tcl_Interp *interp; /* Interpreter to use for error reporting.
- * Interp->result is assumed to be
+ * the interp's result is assumed to be
* initialized by the caller. */
Tk_Window parent; /* Token for parent of new window. */
char *name; /* Name for new window. Must be unique
@@ -878,7 +975,7 @@ Tk_CreateWindow(interp, parent, name, screenName)
* The return value is a token for the new window. This
* is not the same as X's token for the window. If an error
* occurred in creating the window (e.g. no such display or
- * screen), then an error message is left in interp->result and
+ * screen), then an error message is left in the interp's result and
* NULL is returned.
*
* Side effects:
@@ -892,7 +989,7 @@ Tk_CreateWindow(interp, parent, name, screenName)
Tk_Window
Tk_CreateWindowFromPath(interp, tkwin, pathName, screenName)
Tcl_Interp *interp; /* Interpreter to use for error reporting.
- * Interp->result is assumed to be
+ * 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. */
@@ -1011,6 +1108,8 @@ Tk_DestroyWindow(tkwin)
TkWindow *winPtr = (TkWindow *) tkwin;
TkDisplay *dispPtr = winPtr->dispPtr;
XEvent event;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr->flags & TK_ALREADY_DEAD) {
/*
@@ -1054,19 +1153,19 @@ Tk_DestroyWindow(tkwin)
if (winPtr->mainPtr->winPtr == winPtr) {
dispPtr->refCount--;
- if (tkMainWindowList == winPtr->mainPtr) {
- tkMainWindowList = winPtr->mainPtr->nextPtr;
+ if (tsdPtr->mainWindowList == winPtr->mainPtr) {
+ tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr;
} else {
TkMainInfo *prevPtr;
- for (prevPtr = tkMainWindowList;
+ for (prevPtr = tsdPtr->mainWindowList;
prevPtr->nextPtr != winPtr->mainPtr;
prevPtr = prevPtr->nextPtr) {
/* Empty loop body. */
}
prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
}
- numMainWindows--;
+ tsdPtr->numMainWindows--;
}
/*
@@ -1222,8 +1321,8 @@ Tk_DestroyWindow(tkwin)
Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
TkBindFree(winPtr->mainPtr);
- TkFontPkgFree(winPtr->mainPtr);
TkDeleteAllImages(winPtr->mainPtr);
+ TkFontPkgFree(winPtr->mainPtr);
/*
* When embedding Tk into other applications, make sure
@@ -1257,7 +1356,7 @@ Tk_DestroyWindow(tkwin)
* Splice this display out of the list of displays.
*/
- for (theDispPtr = tkDisplayList, backDispPtr = NULL;
+ for (theDispPtr = displayList, backDispPtr = NULL;
(theDispPtr != winPtr->dispPtr) &&
(theDispPtr != NULL);
theDispPtr = theDispPtr->nextPtr) {
@@ -1267,7 +1366,7 @@ Tk_DestroyWindow(tkwin)
panic("could not find display to close!");
}
if (backDispPtr == NULL) {
- tkDisplayList = theDispPtr->nextPtr;
+ displayList = theDispPtr->nextPtr;
} else {
backDispPtr->nextPtr = theDispPtr->nextPtr;
}
@@ -1993,7 +2092,7 @@ TkSetClassProcs(tkwin, procs, instanceData)
* Results:
* The return result is either a token for the window corresponding
* to "name", or else NULL to indicate that there is no such
- * window. In this case, an error message is left in interp->result.
+ * window. In this case, an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -2010,6 +2109,15 @@ Tk_NameToWindow(interp, pathName, 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) {
@@ -2048,7 +2156,7 @@ Tk_IdToWindow(display, window)
TkDisplay *dispPtr;
Tcl_HashEntry *hPtr;
- for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
if (dispPtr == NULL) {
return NULL;
}
@@ -2165,9 +2273,6 @@ Tk_RestackWindow(tkwin, aboveBelow, other)
{
TkWindow *winPtr = (TkWindow *) tkwin;
TkWindow *otherPtr = (TkWindow *) other;
- XWindowChanges changes;
- unsigned int mask;
-
/*
* Special case: if winPtr is a top-level window then just find
@@ -2175,8 +2280,6 @@ Tk_RestackWindow(tkwin, aboveBelow, other)
* otherPtr without changing any of Tk's childLists.
*/
- changes.stack_mode = aboveBelow;
- mask = CWStackMode;
if (winPtr->flags & TK_TOP_LEVEL) {
while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_LEVEL)) {
otherPtr = otherPtr->parentPtr;
@@ -2248,6 +2351,10 @@ Tk_RestackWindow(tkwin, aboveBelow, other)
*/
if (winPtr->window != None) {
+ XWindowChanges changes;
+ unsigned int mask;
+
+ mask = CWStackMode;
changes.stack_mode = Above;
for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
otherPtr = otherPtr->nextPtr) {
@@ -2274,7 +2381,7 @@ Tk_RestackWindow(tkwin, aboveBelow, other)
* Results:
* If interp has a Tk application associated with it, the main
* window for the application is returned. Otherwise NULL is
- * returned and an error message is left in interp->result.
+ * returned and an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -2289,14 +2396,16 @@ Tk_MainWindow(interp)
* reporting also. */
{
TkMainInfo *mainPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (mainPtr = tkMainWindowList; mainPtr != NULL;
+ for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
mainPtr = mainPtr->nextPtr) {
if (mainPtr->interp == interp) {
return (Tk_Window) mainPtr->winPtr;
}
}
- interp->result = "this isn't a Tk application";
+ Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC);
return NULL;
}
@@ -2407,7 +2516,10 @@ OpenIM(dispPtr)
int
Tk_GetNumMainWindows()
{
- return numMainWindows;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->numMainWindows;
}
/*
@@ -2433,8 +2545,10 @@ DeleteWindowsExitProc(clientData)
{
TkDisplay *displayPtr, *nextPtr;
Tcl_Interp *interp;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- while (tkMainWindowList != NULL) {
+ while (tsdPtr->mainWindowList != NULL) {
/*
* We must protect the interpreter while deleting the window,
* because of <Destroy> bindings which could destroy the interpreter
@@ -2442,14 +2556,14 @@ DeleteWindowsExitProc(clientData)
* the call stack pointing at deleted memory, causing core dumps.
*/
- interp = tkMainWindowList->winPtr->mainPtr->interp;
+ interp = tsdPtr->mainWindowList->winPtr->mainPtr->interp;
Tcl_Preserve((ClientData) interp);
- Tk_DestroyWindow((Tk_Window) tkMainWindowList->winPtr);
+ Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
Tcl_Release((ClientData) interp);
}
- displayPtr = tkDisplayList;
- tkDisplayList = NULL;
+ displayPtr = tsdPtr->displayList;
+ tsdPtr->displayList = NULL;
/*
* Iterate destroying the displays until no more displays remain.
@@ -2458,9 +2572,9 @@ DeleteWindowsExitProc(clientData)
* as well as the old ones.
*/
- for (displayPtr = tkDisplayList;
+ for (displayPtr = tsdPtr->displayList;
displayPtr != NULL;
- displayPtr = tkDisplayList) {
+ displayPtr = tsdPtr->displayList) {
/*
* Now iterate over the current list of open displays, and first
@@ -2471,7 +2585,8 @@ DeleteWindowsExitProc(clientData)
* if it needs to dispatch a message.
*/
- for (tkDisplayList = NULL; displayPtr != NULL; displayPtr = nextPtr) {
+ for (tsdPtr->displayList = NULL; displayPtr != NULL;
+ displayPtr = nextPtr) {
nextPtr = displayPtr->nextPtr;
if (displayPtr->name != (char *) NULL) {
ckfree(displayPtr->name);
@@ -2481,12 +2596,9 @@ DeleteWindowsExitProc(clientData)
}
}
- numMainWindows = 0;
- tkMainWindowList = NULL;
- initialized = 0;
- tkDisabledUid = NULL;
- tkActiveUid = NULL;
- tkNormalUid = NULL;
+ tsdPtr->numMainWindows = 0;
+ tsdPtr->mainWindowList = NULL;
+ tsdPtr->initialized = 0;
}
/*
@@ -2504,7 +2616,7 @@ DeleteWindowsExitProc(clientData)
* the arguments that are extracted).
*
* Results:
- * Returns a standard Tcl completion code and sets interp->result
+ * Returns a standard Tcl completion code and sets the interp's result
* if there is an error.
*
* Side effects:
@@ -2529,7 +2641,7 @@ Tk_Init(interp)
* invokes the internal procedure that does the real work.
*
* Results:
- * Returns a standard Tcl completion code and sets interp->result
+ * Returns a standard Tcl completion code and sets the interp's result
* if there is an error.
*
* Side effects:
@@ -2582,6 +2694,9 @@ Tk_SafeInit(interp)
return Initialize(interp);
}
+
+extern TkStubs tkStubs;
+
/*
*----------------------------------------------------------------------
*
@@ -2589,8 +2704,8 @@ Tk_SafeInit(interp)
*
*
* Results:
- * A standard Tcl result. Also leaves an error message in interp->result
- * if there was an error.
+ * 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.
@@ -2606,7 +2721,19 @@ Initialize(interp)
int argc, code;
char **argv, *args[20];
Tcl_DString class;
- char buffer[30];
+ ThreadSpecificData *tsdPtr;
+
+ /*
+ * Ensure that we are getting the matching version of Tcl. This is
+ * really only an issue when Tk is loaded dynamically.
+ */
+
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Start by initializing all the static variables to default acceptable
@@ -2614,6 +2741,7 @@ Initialize(interp)
* code.
*/
+ Tcl_MutexLock(&windowMutex);
synchronize = 0;
name = NULL;
display = NULL;
@@ -2648,6 +2776,7 @@ Initialize(interp)
if (master == NULL) {
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp, "NULL master", (char *) NULL);
+ Tcl_MutexUnlock(&windowMutex);
return TCL_ERROR;
}
if (!Tcl_IsSafe(master)) {
@@ -2661,6 +2790,7 @@ Initialize(interp)
if (Tcl_GetInterpPath(master, interp) != TCL_OK) {
Tcl_AppendResult(interp, "error in Tcl_GetInterpPath",
(char *) NULL);
+ Tcl_MutexUnlock(&windowMutex);
return TCL_ERROR;
}
/*
@@ -2684,6 +2814,7 @@ Initialize(interp)
Tcl_AppendResult(interp,
"not allowed to start Tk by master's safe::TkInit",
(char *) NULL);
+ Tcl_MutexUnlock(&windowMutex);
return TCL_ERROR;
}
Tcl_DStringFree(&ds);
@@ -2705,10 +2836,13 @@ Initialize(interp)
}
argv = NULL;
if (p != NULL) {
+ char buffer[TCL_INTEGER_SPACE];
+
if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
argError:
Tcl_AddErrorInfo(interp,
"\n (processing arguments in argv variable)");
+ Tcl_MutexUnlock(&windowMutex);
return TCL_ERROR;
}
if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
@@ -2741,8 +2875,8 @@ Initialize(interp)
}
p = Tcl_DStringValue(&class);
- if (islower(UCHAR(*p))) {
- *p = toupper(UCHAR(*p));
+ if (*p) {
+ Tcl_UtfToTitle(p);
}
/*
@@ -2766,7 +2900,7 @@ Initialize(interp)
* that it will be available to subprocesses created by us.
*/
- if (numMainWindows == 0) {
+ if (tsdPtr->numMainWindows == 0) {
Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
}
}
@@ -2813,15 +2947,28 @@ Initialize(interp)
}
geometry = NULL;
}
+ Tcl_MutexUnlock(&windowMutex);
+
if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
code = TCL_ERROR;
goto done;
}
- code = Tcl_PkgProvide(interp, "Tk", TK_VERSION);
+
+ /*
+ * Provide Tk and its stub table.
+ */
+
+ code = Tcl_PkgProvideEx(interp, "Tk", TK_VERSION, (ClientData) &tkStubs);
if (code != TCL_OK) {
goto done;
}
+#ifdef Tk_InitStubs
+#undef Tk_InitStubs
+#endif
+
+ Tk_InitStubs(interp, TK_VERSION, 1);
+
/*
* Invoke platform-specific initialization.
*/
@@ -2834,3 +2981,5 @@ Initialize(interp)
}
return code;
}
+
+
diff --git a/tk/generic/tkXId.c b/tk/generic/tkXId.c
new file mode 100644
index 00000000000..8cf397d9dd4
--- /dev/null
+++ b/tk/generic/tkXId.c
@@ -0,0 +1,495 @@
+/*
+ * tkXId.c --
+ *
+ * This file provides a replacement function for the default X
+ * resource allocator (_XAllocID). The problem with the default
+ * allocator is that it never re-uses ids, which causes long-lived
+ * applications to crash when X resource identifiers wrap around.
+ * The replacement functions in this file re-use old identifiers
+ * to prevent this problem.
+ *
+ * The code in this file is based on similar implementations by
+ * George C. Kaplan and Michael Hoegeman.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkXId.c 1.16 96/02/28 21:56:40
+ */
+
+/*
+ * The definition below is needed on some systems so that we can access
+ * the resource_alloc field of Display structures in order to replace
+ * the resource allocator.
+ */
+
+#define XLIB_ILLEGAL_ACCESS 1
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * A structure of the following type is used to hold one or more
+ * available resource identifiers. There is a list of these structures
+ * for each display.
+ */
+
+#define IDS_PER_STACK 10
+typedef struct TkIdStack {
+ XID ids[IDS_PER_STACK]; /* Array of free identifiers. */
+ int numUsed; /* Indicates how many of the entries
+ * in ids are currently in use. */
+ TkDisplay *dispPtr; /* Display to which ids belong. */
+ struct TkIdStack *nextPtr; /* Next bunch of free identifiers
+ * for the same display. */
+} TkIdStack;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static XID AllocXId _ANSI_ARGS_((Display *display));
+static Tk_RestrictAction CheckRestrictProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void WindowIdCleanup _ANSI_ARGS_((ClientData clientData));
+static void WindowIdCleanup2 _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitXId --
+ *
+ * This procedure is called to initialize the id allocator for
+ * a given display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The official allocator for the display is set up to be Tk_AllocXID.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitXId(dispPtr)
+ TkDisplay *dispPtr; /* Tk's information about the
+ * display. */
+{
+ dispPtr->idStackPtr = NULL;
+ dispPtr->defaultAllocProc = dispPtr->display->resource_alloc;
+ dispPtr->display->resource_alloc = AllocXId;
+ dispPtr->windowStackPtr = NULL;
+ dispPtr->idCleanupScheduled = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocXId --
+ *
+ * This procedure is invoked by Xlib as the resource allocator
+ * for a display.
+ *
+ * Results:
+ * The return value is an X resource identifier that isn't currently
+ * in use.
+ *
+ * Side effects:
+ * The identifier is removed from the stack of free identifiers,
+ * if it was previously on the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static XID
+AllocXId(display)
+ Display *display; /* Display for which to allocate. */
+{
+ TkDisplay *dispPtr;
+ TkIdStack *stackPtr;
+
+ /*
+ * Find Tk's information about the display.
+ */
+
+ dispPtr = TkGetDisplay(display);
+
+ /*
+ * If the topmost chunk on the stack is empty then free it. Then
+ * check for a free id on the stack and return it if it exists.
+ */
+
+ stackPtr = dispPtr->idStackPtr;
+ if (stackPtr != NULL) {
+ while (stackPtr->numUsed == 0) {
+ dispPtr->idStackPtr = stackPtr->nextPtr;
+ ckfree((char *) stackPtr);
+ stackPtr = dispPtr->idStackPtr;
+ if (stackPtr == NULL) {
+ goto defAlloc;
+ }
+ }
+ stackPtr->numUsed--;
+ return stackPtr->ids[stackPtr->numUsed];
+ }
+
+ /*
+ * No free ids in the stack: just get one from the default
+ * allocator.
+ */
+
+ defAlloc:
+ return (*dispPtr->defaultAllocProc)(display);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeXId --
+ *
+ * This procedure is called to indicate that an X resource identifier
+ * is now free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The identifier is added to the stack of free identifiers for its
+ * display, so that it can be re-used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeXId(display, xid)
+ Display *display; /* Display for which xid was
+ * allocated. */
+ XID xid; /* Identifier that is no longer
+ * in use. */
+{
+ TkDisplay *dispPtr;
+ TkIdStack *stackPtr;
+
+ /*
+ * Find Tk's information about the display.
+ */
+
+ dispPtr = TkGetDisplay(display);
+
+ /*
+ * Add a new chunk to the stack if the current chunk is full.
+ */
+
+ stackPtr = dispPtr->idStackPtr;
+ if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) {
+ stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack));
+ stackPtr->numUsed = 0;
+ stackPtr->dispPtr = dispPtr;
+ stackPtr->nextPtr = dispPtr->idStackPtr;
+ dispPtr->idStackPtr = stackPtr;
+ }
+
+ /*
+ * Add the id to the current chunk.
+ */
+
+ stackPtr->ids[stackPtr->numUsed] = xid;
+ stackPtr->numUsed++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeWindowId --
+ *
+ * This procedure is invoked instead of TkFreeXId for window ids.
+ * See below for the reason why.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The id given by w will eventually be freed, so that it can be
+ * reused for other resources.
+ *
+ * Design:
+ * Freeing window ids is very tricky because there could still be
+ * events pending for a window in the event queue (or even in the
+ * server) at the time the window is destroyed. If the window
+ * id were to get reused immediately for another window, old
+ * events could "drop in" on the new window, causing unexpected
+ * behavior.
+ *
+ * Thus we have to wait to re-use a window id until we know that
+ * there are no events left for it. Right now this is done in
+ * two steps. First, we wait until we know that the server
+ * has seen the XDestroyWindow request, so we can be sure that
+ * it won't generate more events for the window and that any
+ * existing events are in our queue. Second, we make sure that
+ * there are no events whatsoever in our queue (this is conservative
+ * but safe).
+ *
+ * The first step is done by remembering the request id of the
+ * XDestroyWindow request and using LastKnownRequestProcessed to
+ * see what events the server has processed. If multiple windows
+ * get destroyed at about the same time, we just remember the
+ * most recent request number for any of them (again, conservative
+ * but safe).
+ *
+ * There are a few other complications as well. When Tk destroys a
+ * sub-tree of windows, it only issues a single XDestroyWindow call,
+ * at the very end for the root of the subtree. We can't free any of
+ * the window ids until the final XDestroyWindow call. To make sure
+ * that this happens, we have to keep track of deletions in progress,
+ * hence the need for the "destroyCount" field of the display.
+ *
+ * One final problem. Some servers, like Sun X11/News servers still
+ * seem to have problems with ids getting reused too quickly. I'm
+ * not completely sure why this is a problem, but delaying the
+ * recycling of ids appears to eliminate it. Therefore, we wait
+ * an additional few seconds, even after "the coast is clear"
+ * before reusing the ids.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeWindowId(dispPtr, w)
+ TkDisplay *dispPtr; /* Display that w belongs to. */
+ Window w; /* X identifier for window on dispPtr. */
+{
+ TkIdStack *stackPtr;
+
+ /*
+ * Put the window id on a separate stack of window ids, rather
+ * than the main stack, so it won't get reused right away. Add
+ * a new chunk to the stack if the current chunk is full.
+ */
+
+ stackPtr = dispPtr->windowStackPtr;
+ if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) {
+ stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack));
+ stackPtr->numUsed = 0;
+ stackPtr->dispPtr = dispPtr;
+ stackPtr->nextPtr = dispPtr->windowStackPtr;
+ dispPtr->windowStackPtr = stackPtr;
+ }
+
+ /*
+ * Add the id to the current chunk.
+ */
+
+ stackPtr->ids[stackPtr->numUsed] = w;
+ stackPtr->numUsed++;
+
+ /*
+ * Schedule a call to WindowIdCleanup if one isn't already
+ * scheduled.
+ */
+
+ if (!dispPtr->idCleanupScheduled) {
+ dispPtr->idCleanupScheduled = 1;
+ Tcl_CreateTimerHandler(100, WindowIdCleanup, (ClientData *) dispPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowIdCleanup --
+ *
+ * See if we can now free up all the accumulated ids of
+ * deleted windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If it's safe to move the window ids back to the main free
+ * list, we schedule this to happen after a few mores seconds
+ * of delay. If it's not safe to move them yet, a timer handler
+ * gets invoked to try again later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WindowIdCleanup(clientData)
+ ClientData clientData; /* Pointer to TkDisplay for display */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ int anyEvents, delta;
+ Tk_RestrictProc *oldProc;
+ ClientData oldData;
+
+ dispPtr->idCleanupScheduled = 0;
+
+ /*
+ * See if it's safe to recycle the window ids. It's safe if:
+ * (a) no deletions are in progress.
+ * (b) the server has seen all of the requests up to the last
+ * XDestroyWindow request.
+ * (c) there are no events in the event queue; the only way to
+ * test for this right now is to create a restrict proc that
+ * will filter the events, then call Tcl_DoOneEvent to see if
+ * the procedure gets invoked.
+ */
+
+ if (dispPtr->destroyCount > 0) {
+ goto tryAgain;
+ }
+ delta = LastKnownRequestProcessed(dispPtr->display)
+ - dispPtr->lastDestroyRequest;
+ if (delta < 0) {
+ XSync(dispPtr->display, False);
+ }
+ anyEvents = 0;
+ oldProc = Tk_RestrictEvents(CheckRestrictProc, (ClientData) &anyEvents,
+ &oldData);
+ Tcl_DoOneEvent(TCL_DONT_WAIT|TCL_WINDOW_EVENTS);
+ Tk_RestrictEvents(oldProc, oldData, &oldData);
+ if (anyEvents) {
+ goto tryAgain;
+ }
+
+ /*
+ * These ids look safe to recycle, but we still need to delay a bit
+ * more (see comments for TkFreeWindowId). Schedule the final freeing.
+ */
+
+ if (dispPtr->windowStackPtr != NULL) {
+ Tcl_CreateTimerHandler(5000, WindowIdCleanup2,
+ (ClientData) dispPtr->windowStackPtr);
+ dispPtr->windowStackPtr = NULL;
+ }
+ return;
+
+ /*
+ * It's still not safe to free up the ids. Try again a bit later.
+ */
+
+ tryAgain:
+ dispPtr->idCleanupScheduled = 1;
+ Tcl_CreateTimerHandler(500, WindowIdCleanup, (ClientData *) dispPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowIdCleanup2 --
+ *
+ * This procedure is the last one in the chain that recycles
+ * window ids. It takes all of the ids indicated by its
+ * argument and adds them back to the main id free list.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Window ids get added to the main free list for their display.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WindowIdCleanup2(clientData)
+ ClientData clientData; /* Pointer to TkIdStack list. */
+{
+ TkIdStack *stackPtr = (TkIdStack *) clientData;
+ TkIdStack *lastPtr;
+
+ lastPtr = stackPtr;
+ while (lastPtr->nextPtr != NULL) {
+ lastPtr = lastPtr->nextPtr;
+ }
+ lastPtr->nextPtr = stackPtr->dispPtr->idStackPtr;
+ stackPtr->dispPtr->idStackPtr = stackPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckRestrictProc --
+ *
+ * This procedure is a restrict procedure, called by Tcl_DoOneEvent
+ * to filter X events. All it does is to set a flag to indicate
+ * that there are X events present.
+ *
+ * Results:
+ * Sets the integer pointed to by the argument, then returns
+ * TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+CheckRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to flag to set. */
+ XEvent *eventPtr; /* Event to filter; not used. */
+{
+ int *flag = (int *) clientData;
+ *flag = 1;
+ return TK_DEFER_EVENT;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixmap --
+ *
+ * Same as the XCreatePixmap procedure except that it manages
+ * resource identifiers better.
+ *
+ * Results:
+ * Returns a new pixmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetPixmap(display, d, width, height, depth)
+ Display *display; /* Display for new pixmap. */
+ Drawable d; /* Drawable where pixmap will be used. */
+ int width, height; /* Dimensions of pixmap. */
+ int depth; /* Bits per pixel for pixmap. */
+{
+ return XCreatePixmap(display, d, (unsigned) width, (unsigned) height,
+ (unsigned) depth);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreePixmap --
+ *
+ * Same as the XFreePixmap procedure except that it also marks
+ * the resource identifier as free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap is freed in the X server and its resource identifier
+ * is saved for re-use.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreePixmap(display, pixmap)
+ Display *display; /* Display for which pixmap was allocated. */
+ Pixmap pixmap; /* Identifier for pixmap. */
+{
+ XFreePixmap(display, pixmap);
+ Tk_FreeXId(display, (XID) pixmap);
+}
diff --git a/tk/library/bgerror.tcl b/tk/library/bgerror.tcl
index 2c43305edf3..e5f47f324a9 100644
--- a/tk/library/bgerror.tcl
+++ b/tk/library/bgerror.tcl
@@ -4,7 +4,7 @@
# posts a dialog box with the error message and gives the user a chance
# to see a more detailed stack trace.
#
-# SCCS: @(#) bgerror.tcl 1.16 97/08/06 09:19:50
+# RCS: @(#) $Id$
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -23,7 +23,7 @@
proc bgerror err {
global errorInfo tcl_platform
-
+
# save errorInfo which would be erased in the catch below otherwise.
set info $errorInfo ;
@@ -35,7 +35,8 @@ proc bgerror err {
# code from the tkerror trial, other ret codes are passed back
# to our caller (tcl background error handler) so the called "tkerror"
# can still use return -code break, to skip remaining messages
- # in the error queue for instance) -- dl
+ # in the error queue for instance)
+
set ret [catch {tkerror $err} msg];
if {$ret != 1} {return -code $ret $msg}
@@ -61,7 +62,7 @@ proc bgerror err {
wm title $w "Stack Trace for Error"
wm iconname $w "Stack Trace"
button $w.ok -text OK -command "destroy $w" -default active
- if {$tcl_platform(platform) == "macintosh"} {
+ if {![string compare $tcl_platform(platform) "macintosh"]} {
text $w.text -relief flat -bd 2 -highlightthickness 0 -setgrid true \
-yscrollcommand "$w.scroll set" -width 60 -height 20
} else {
@@ -93,7 +94,9 @@ proc bgerror err {
# screen, since they could make it impossible for the user
# to interact with the stack trace.
- if {[grab current .] != ""} {
+ if {[string compare [grab current .] ""]} {
grab release [grab current .]
}
}
+
+
diff --git a/tk/library/button.tcl b/tk/library/button.tcl
index b490f76f99c..d930aee86ef 100644
--- a/tk/library/button.tcl
+++ b/tk/library/button.tcl
@@ -4,7 +4,7 @@
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
-# SCCS: @(#) button.tcl 1.22 96/11/14 14:49:11
+# RCS: @(#) $Id$
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -17,7 +17,7 @@
# The code below creates the default class bindings for buttons.
#-------------------------------------------------------------------------
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string match "macintosh" $tcl_platform(platform)]} {
bind Radiobutton <Enter> {
tkButtonEnter %W
}
@@ -37,16 +37,7 @@ if {$tcl_platform(platform) == "macintosh"} {
tkButtonUp %W
}
}
-if {$tcl_platform(platform) == "windows"} {
- bind Button <Return> {
- tkButtonInvoke %W
- }
- bind Checkbutton <Return> {
- tkCheckRadioInvoke %W
- }
- bind Radiobutton <Return> {
- tkCheckRadioInvoke %W
- }
+if {[string match "windows" $tcl_platform(platform)]} {
bind Checkbutton <equal> {
tkCheckRadioInvoke %W select
}
@@ -76,7 +67,7 @@ if {$tcl_platform(platform) == "windows"} {
tkCheckRadioEnter %W
}
}
-if {$tcl_platform(platform) == "unix"} {
+if {[string match "unix" $tcl_platform(platform)]} {
bind Checkbutton <Return> {
if {!$tk_strictMotif} {
tkCheckRadioInvoke %W
@@ -135,7 +126,7 @@ bind Radiobutton <Leave> {
tkButtonLeave %W
}
-if {$tcl_platform(platform) == "windows"} {
+if {[string match "windows" $tcl_platform(platform)]} {
#########################
# Windows implementation
@@ -151,10 +142,9 @@ if {$tcl_platform(platform) == "windows"} {
proc tkButtonEnter w {
global tkPriv
- if {[$w cget -state] != "disabled"} {
- if {$tkPriv(buttonWindow) == $w} {
- $w configure -state active -relief sunken
- }
+ if {[string compare [$w cget -state] "disabled"] \
+ && [string equal $tkPriv(buttonWindow) $w]} {
+ $w configure -state active -relief sunken
}
set tkPriv(window) $w
}
@@ -171,10 +161,10 @@ proc tkButtonEnter w {
proc tkButtonLeave w {
global tkPriv
- if {[$w cget -state] != "disabled"} {
- $w config -state normal
+ if {[string compare [$w cget -state] "disabled"]} {
+ $w configure -state normal
}
- if {$w == $tkPriv(buttonWindow)} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
$w configure -relief $tkPriv(relief)
}
set tkPriv(window) ""
@@ -191,10 +181,9 @@ proc tkButtonLeave w {
proc tkCheckRadioEnter w {
global tkPriv
- if {[$w cget -state] != "disabled"} {
- if {$tkPriv(buttonWindow) == $w} {
- $w configure -state active
- }
+ if {[string compare [$w cget -state] "disabled"] \
+ && [string equal $tkPriv(buttonWindow) $w]} {
+ $w configure -state active
}
set tkPriv(window) $w
}
@@ -210,10 +199,10 @@ proc tkCheckRadioEnter w {
proc tkButtonDown w {
global tkPriv
- set tkPriv(relief) [lindex [$w conf -relief] 4]
- if {[$w cget -state] != "disabled"} {
+ set tkPriv(relief) [$w cget -relief]
+ if {[string compare [$w cget -state] "disabled"]} {
set tkPriv(buttonWindow) $w
- $w config -relief sunken -state active
+ $w configure -relief sunken -state active
}
}
@@ -228,10 +217,10 @@ proc tkButtonDown w {
proc tkCheckRadioDown w {
global tkPriv
- set tkPriv(relief) [lindex [$w conf -relief] 4]
- if {[$w cget -state] != "disabled"} {
+ set tkPriv(relief) [$w cget -relief]
+ if {[string compare [$w cget -state] "disabled"]} {
set tkPriv(buttonWindow) $w
- $w config -state active
+ $w configure -state active
}
}
@@ -245,11 +234,12 @@ proc tkCheckRadioDown w {
proc tkButtonUp w {
global tkPriv
- if {$w == $tkPriv(buttonWindow)} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
set tkPriv(buttonWindow) ""
- if {($w == $tkPriv(window))
- && ([$w cget -state] != "disabled")} {
- $w config -relief $tkPriv(relief) -state normal
+ $w configure -relief $tkPriv(relief)
+ if {[string equal $tkPriv(window) $w]
+ && [string compare [$w cget -state] "disabled"]} {
+ $w configure -state normal
uplevel #0 [list $w invoke]
}
}
@@ -257,7 +247,7 @@ proc tkButtonUp w {
}
-if {$tcl_platform(platform) == "unix"} {
+if {[string match "unix" $tcl_platform(platform)]} {
#####################
# Unix implementation
@@ -273,9 +263,9 @@ if {$tcl_platform(platform) == "unix"} {
proc tkButtonEnter {w} {
global tkPriv
- if {[$w cget -state] != "disabled"} {
- $w config -state active
- if {$tkPriv(buttonWindow) == $w} {
+ if {[string compare [$w cget -state] "disabled"]} {
+ $w configure -state active
+ if {[string equal $tkPriv(buttonWindow) $w]} {
$w configure -state active -relief sunken
}
}
@@ -294,10 +284,10 @@ proc tkButtonEnter {w} {
proc tkButtonLeave w {
global tkPriv
- if {[$w cget -state] != "disabled"} {
- $w config -state normal
+ if {[string compare [$w cget -state] "disabled"]} {
+ $w configure -state normal
}
- if {$w == $tkPriv(buttonWindow)} {
+ if {[string equal $tkPriv(buttonWindow) $w]} {
$w configure -relief $tkPriv(relief)
}
set tkPriv(window) ""
@@ -314,10 +304,10 @@ proc tkButtonLeave w {
proc tkButtonDown w {
global tkPriv
- set tkPriv(relief) [lindex [$w config -relief] 4]
- if {[$w cget -state] != "disabled"} {
+ set tkPriv(relief) [$w cget -relief]
+ if {[string compare [$w cget -state] "disabled"]} {
set tkPriv(buttonWindow) $w
- $w config -relief sunken
+ $w configure -relief sunken
}
}
@@ -331,11 +321,11 @@ proc tkButtonDown w {
proc tkButtonUp w {
global tkPriv
- if {$w == $tkPriv(buttonWindow)} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
set tkPriv(buttonWindow) ""
- $w config -relief $tkPriv(relief)
- if {($w == $tkPriv(window))
- && ([$w cget -state] != "disabled")} {
+ $w configure -relief $tkPriv(relief)
+ if {[string equal $w $tkPriv(window)] \
+ && [string compare [$w cget -state] "disabled"]} {
uplevel #0 [list $w invoke]
}
}
@@ -343,7 +333,7 @@ proc tkButtonUp w {
}
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string match "macintosh" $tcl_platform(platform)]} {
####################
# Mac implementation
@@ -359,8 +349,8 @@ if {$tcl_platform(platform) == "macintosh"} {
proc tkButtonEnter {w} {
global tkPriv
- if {[$w cget -state] != "disabled"} {
- if {$tkPriv(buttonWindow) == $w} {
+ if {[string compare [$w cget -state] "disabled"]} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
$w configure -state active
}
}
@@ -379,7 +369,7 @@ proc tkButtonEnter {w} {
proc tkButtonLeave w {
global tkPriv
- if {$w == $tkPriv(buttonWindow)} {
+ if {[string equal $w $tkPriv(buttonWindow)]} {
$w configure -state normal
}
set tkPriv(window) ""
@@ -396,9 +386,9 @@ proc tkButtonLeave w {
proc tkButtonDown w {
global tkPriv
- if {[$w cget -state] != "disabled"} {
+ if {[string compare [$w cget -state] "disabled"]} {
set tkPriv(buttonWindow) $w
- $w config -state active
+ $w configure -state active
}
}
@@ -412,11 +402,11 @@ proc tkButtonDown w {
proc tkButtonUp w {
global tkPriv
- if {$w == $tkPriv(buttonWindow)} {
- $w config -state normal
+ if {[string equal $w $tkPriv(buttonWindow)]} {
+ $w configure -state normal
set tkPriv(buttonWindow) ""
- if {($w == $tkPriv(window))
- && ([$w cget -state] != "disabled")} {
+ if {[string equal $w $tkPriv(window)]
+ && [string compare [$w cget -state] "disabled"]} {
uplevel #0 [list $w invoke]
}
}
@@ -436,7 +426,7 @@ proc tkButtonUp w {
# w - The name of the widget.
proc tkButtonInvoke w {
- if {[$w cget -state] != "disabled"} {
+ if {[string compare [$w cget -state] "disabled"]} {
set oldRelief [$w cget -relief]
set oldState [$w cget -state]
$w configure -state active -relief sunken
@@ -458,8 +448,9 @@ proc tkButtonInvoke w {
# cmd - The subcommand to invoke (one of invoke, select, or deselect).
proc tkCheckRadioInvoke {w {cmd invoke}} {
- if {[$w cget -state] != "disabled"} {
+ if {[string compare [$w cget -state] "disabled"]} {
uplevel #0 [list $w $cmd]
}
}
+
diff --git a/tk/library/choosedir.tcl b/tk/library/choosedir.tcl
new file mode 100644
index 00000000000..0d0972ebb67
--- /dev/null
+++ b/tk/library/choosedir.tcl
@@ -0,0 +1,264 @@
+# 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 {
+}
+
+# ::tk::dialog::file::tkChooseDirectory --
+#
+# Implements the TK directory selection dialog.
+#
+# Arguments:
+# args Options parsed by the procedure.
+#
+proc ::tk::dialog::file::chooseDir::tkChooseDirectory {args} {
+ global tkPriv
+ 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
+ }
+ 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.
+
+ tkwait variable tkPriv(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 $tkPriv(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) "Choose Directory"
+ }
+
+ # 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 iconText [tkIconList_Get $data(icons)]
+ if { ![string equal $iconText ""] } {
+ 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 text [tkIconList_Get $data(icons)]
+ if {[string compare $text ""]} {
+ set file $data(selectPath)
+ if {[file isdirectory $file]} {
+ ::tk::dialog::file::ListInvoke $w $text
+ 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
+# tkPriv(selectFilePath) variable, which will break the "tkwait"
+# 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
+ global tkPriv
+
+ if {[string equal $selectFilePath ""]} {
+ set selectFilePath $data(selectPath)
+ }
+ if { $data(-mustexist) } {
+ if { ![file exists $selectFilePath] || \
+ ![file isdir $selectFilePath] } {
+ return
+ }
+ }
+ set tkPriv(selectFilePath) $selectFilePath
+}
diff --git a/tk/library/clrpick.tcl b/tk/library/clrpick.tcl
index a06b2e2ab4a..cf7dc04ef73 100644
--- a/tk/library/clrpick.tcl
+++ b/tk/library/clrpick.tcl
@@ -3,7 +3,7 @@
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
-# SCCS: @(#) clrpick.tcl 1.3 96/09/05 09:59:24
+# RCS: @(#) $Id$
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -59,36 +59,28 @@ proc tkColorDialog {args} {
tkColorDialog_Config $w $args
tkColorDialog_InitValues $w
- if {![winfo exists $w]} {
- toplevel $w -class tkColorDialog
+ 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
tkColorDialog_BuildDialog $w
}
- wm transient $w $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.
- 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
+ ::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
# 6. Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {$oldGrab != ""} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- focus $data(okBtn)
+ ::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
@@ -96,18 +88,10 @@ proc tkColorDialog {args} {
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
- tkwait variable tkPriv(selectColor)
- catch {focus $oldFocus}
- grab release $w
- destroy $w
+ vwait tkPriv(selectColor)
+ ::tk::RestoreFocusGrab $w $data(okBtn)
unset data
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
+
return $tkPriv(selectColor)
}
@@ -147,8 +131,7 @@ proc tkColorDialog_InitValues {w} {
#
# canvasWidth is the width of the entire canvas, including the indents
#
- set data(canvasWidth) [expr {$data(BARS_WIDTH) + \
- $data(PLGN_WIDTH)}]
+ 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.
@@ -171,30 +154,28 @@ proc tkColorDialog_Config {w argList} {
# 1: the configuration specs
#
- set specs {
- {-initialcolor "" "" ""}
- {-parent "" "" "."}
- {-title "" "" "Color"}
+ if {[info exists tkPriv(selectColor)] && \
+ [string compare $tkPriv(selectColor) ""]} {
+ set defaultColor $tkPriv(selectColor)
+ } else {
+ set defaultColor [. cget -background]
}
+ set specs [list \
+ [list -initialcolor "" "" $defaultColor] \
+ [list -parent "" "" "."] \
+ [list -title "" "" "Color"] \
+ ]
+
# 2: parse the arguments
#
tclParseConfigSpec $w $specs "" $argList
- if {![string compare $data(-title) ""]} {
+ if {[string equal $data(-title) ""]} {
set data(-title) " "
}
- if {![string compare $data(-initialcolor) ""]} {
- if {[info exists tkPriv(selectColor)] && \
- [string compare $tkPriv(selectColor) ""]} {
- set data(-initialcolor) $tkPriv(selectColor)
- } else {
- set data(-initialcolor) [. cget -background]
- }
- } else {
- if {[catch {winfo rgb . $data(-initialcolor)} err]} {
- error $err
- }
+ if {[catch {winfo rgb . $data(-initialcolor)} err]} {
+ error $err
}
if {![winfo exists $data(-parent)]} {
@@ -250,18 +231,18 @@ proc tkColorDialog_BuildDialog {w} {
set data($color,sel) $f.sel
bind $data($color,col) <Configure> \
- "tkColorDialog_DrawColorScale $w $color 1"
+ [list tkColorDialog_DrawColorScale $w $color 1]
bind $data($color,col) <Enter> \
- "tkColorDialog_EnterColorBar $w $color"
+ [list tkColorDialog_EnterColorBar $w $color]
bind $data($color,col) <Leave> \
- "tkColorDialog_LeaveColorBar $w $color"
+ [list tkColorDialog_LeaveColorBar $w $color]
bind $data($color,sel) <Enter> \
- "tkColorDialog_EnterColorBar $w $color"
+ [list tkColorDialog_EnterColorBar $w $color]
bind $data($color,sel) <Leave> \
- "tkColorDialog_LeaveColorBar $w $color"
-
- bind $box.entry <Return> "tkColorDialog_HandleRGBEntry $w"
+ [list tkColorDialog_LeaveColorBar $w $color]
+
+ bind $box.entry <Return> [list tkColorDialog_HandleRGBEntry $w]
}
pack $stripsFrame -side left -fill both -padx 4 -pady 10
@@ -280,7 +261,7 @@ proc tkColorDialog_BuildDialog {w} {
pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
pack $data(finalCanvas) -expand yes -fill both
- bind $ent <Return> "tkColorDialog_HandleSelEntry $w"
+ bind $ent <Return> [list tkColorDialog_HandleSelEntry $w]
pack $selFrame -side left -fill none -anchor nw
pack $topFrame -side top -expand yes -fill both -anchor nw
@@ -289,9 +270,9 @@ proc tkColorDialog_BuildDialog {w} {
#
set botFrame [frame $w.bot -relief raised -bd 1]
button $botFrame.ok -text OK -width 8 -under 0 \
- -command "tkColorDialog_OkCmd $w"
+ -command [list tkColorDialog_OkCmd $w]
button $botFrame.cancel -text Cancel -width 8 -under 0 \
- -command "tkColorDialog_CancelCmd $w"
+ -command [list tkColorDialog_CancelCmd $w]
set data(okBtn) $botFrame.ok
set data(cancelBtn) $botFrame.cancel
@@ -303,15 +284,15 @@ proc tkColorDialog_BuildDialog {w} {
# Accelerator bindings
- bind $w <Alt-r> "focus $data(red,entry)"
- bind $w <Alt-g> "focus $data(green,entry)"
- bind $w <Alt-b> "focus $data(blue,entry)"
- bind $w <Alt-s> "focus $ent"
- bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-o> "tkButtonInvoke $data(okBtn)"
+ bind $w <Alt-r> [list focus $data(red,entry)]
+ bind $w <Alt-g> [list focus $data(green,entry)]
+ bind $w <Alt-b> [list focus $data(blue,entry)]
+ bind $w <Alt-s> [list focus $ent]
+ bind $w <KeyPress-Escape> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-o> [list tkButtonInvoke $data(okBtn)]
- wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
+ wm protocol $w WM_DELETE_WINDOW [list tkColorDialog_CancelCmd $w]
}
# tkColorDialog_SetRGBValue --
@@ -386,48 +367,47 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} {
# Draw the selection polygons
tkColorDialog_CreateSelector $w $sel $c
$sel bind $data($c,index) <ButtonPress-1> \
- "tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1"
+ [list tkColorDialog_StartMove $w $sel $c %x $data(selPad) 1]
$sel bind $data($c,index) <B1-Motion> \
- "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,index) <ButtonRelease-1> \
- "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
set height [winfo height $col]
# Create an invisible region under the colorstrip to catch mouse clicks
# that aren't on the selector.
set data($c,clickRegion) [$sel create rectangle 0 0 \
- $data(canvasWidth) $height -fill {} -outline {}]
+ $data(canvasWidth) $height -fill {} -outline {}]
bind $col <ButtonPress-1> \
- "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
+ [list tkColorDialog_StartMove $w $sel $c %x $data(colorPad)]
bind $col <B1-Motion> \
- "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
+ [list tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)]
bind $col <ButtonRelease-1> \
- "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
+ [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)]
$sel bind $data($c,clickRegion) <ButtonPress-1> \
- "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_StartMove $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) <B1-Motion> \
- "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)]
$sel bind $data($c,clickRegion) <ButtonRelease-1> \
- "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+ [list tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)]
} else {
# l is the canvas index of the first colorbar.
set l $data(lines,$c,start)
}
# Draw the color bars.
- set highlightW [expr \
- {[$col cget -highlightthickness] + [$col cget -bd]}]
+ set highlightW [expr {[$col cget -highlightthickness] + [$col cget -bd]}]
for {set i 0} { $i < $data(NUM_COLORBARS)} { incr i} {
set intensity [expr {$i * $data(intensityIncr)}]
set startx [expr {$i * $data(colorbarWidth) + $highlightW}]
- if { $c == "red" } {
+ if {[string equal $c "red"]} {
set color [format "#%02x%02x%02x" \
$intensity \
$data(green,intensity) \
$data(blue,intensity)]
- } elseif { $c == "green" } {
+ } elseif {[string equal $c "green"]} {
set color [format "#%02x%02x%02x" \
$data(red,intensity) \
$intensity \
@@ -445,7 +425,7 @@ proc tkColorDialog_DrawColorScale {w c {create 0}} {
[expr {[winfo height $col] + $highlightW}]\
-fill $color -outline $color]
} else {
- $col itemconf $l -fill $color -outline $color
+ $col itemconfigure $l -fill $color -outline $color
incr l
}
}
@@ -484,13 +464,13 @@ proc tkColorDialog_RedrawFinalColor {w} {
set color [format "#%02x%02x%02x" $data(red,intensity) \
$data(green,intensity) $data(blue,intensity)]
- $data(finalCanvas) conf -bg $color
+ $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)]
+ $data(red,intensity) \
+ $data(green,intensity) \
+ $data(blue,intensity)]
}
# tkColorDialog_RedrawColorBars --
@@ -603,7 +583,7 @@ proc tkColorDialog_ResizeColorBars {w} {
}
tkColorDialog_InitValues $w
foreach color { red green blue } {
- $data($color,col) conf -width $data(canvasWidth)
+ $data($color,col) configure -width $data(canvasWidth)
tkColorDialog_DrawColorScale $w $color 1
}
}
@@ -689,3 +669,5 @@ proc tkColorDialog_CancelCmd {w} {
set tkPriv(selectColor) ""
}
+
+
diff --git a/tk/library/comdlg.tcl b/tk/library/comdlg.tcl
index 30e4c813df8..929f741a1bb 100644
--- a/tk/library/comdlg.tcl
+++ b/tk/library/comdlg.tcl
@@ -3,7 +3,7 @@
# Some functions needed for the common dialog boxes. Probably need to go
# in a different file.
#
-# SCCS: @(#) comdlg.tcl 1.4 96/09/05 09:07:54
+# RCS: @(#) $Id$
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -52,13 +52,12 @@ proc tclParseConfigSpec {w specs flags argList} {
set verproc($cmdsw) [lindex $spec 4]
}
- if {([llength $argList]%2) != 0} {
- foreach {cmdsw value} $argList {
- if {![info exists cmd($cmdsw)]} {
- error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
- }
+ 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 \"[lindex $argList end]\" missing"
+ error "value for \"$cmdsw\" missing"
}
# 2: set the default values
@@ -71,7 +70,7 @@ proc tclParseConfigSpec {w specs flags argList} {
#
foreach {cmdsw value} $argList {
if {![info exists cmd($cmdsw)]} {
- error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
+ error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
}
set data($cmdsw) $value
}
@@ -90,7 +89,7 @@ proc tclListValidFlags {v} {
append errormsg "$separator$cmdsw"
incr i
if {$i == $len} {
- set separator " or "
+ set separator ", or "
} else {
set separator ", "
}
@@ -98,21 +97,6 @@ proc tclListValidFlags {v} {
return $errormsg
}
-# This procedure is used to sort strings in a case-insenstive mode.
-#
-proc tclSortNoCase {str1 str2} {
- return [string compare [string toupper $str1] [string toupper $str2]]
-}
-
-
-# Gives an error if the string does not contain a valid integer
-# number
-#
-proc tclVerifyInteger {string} {
- lindex {1 2 3} $string
-}
-
-
#----------------------------------------------------------------------
#
# Focus Group
@@ -143,9 +127,9 @@ proc tkFocusGroup_Create {t} {
if {![info exists tkPriv(fg,$t)]} {
set tkPriv(fg,$t) 1
set tkPriv(focus,$t) ""
- bind $t <FocusIn> "tkFocusGroup_In $t %W %d"
- bind $t <FocusOut> "tkFocusGroup_Out $t %W %d"
- bind $t <Destroy> "tkFocusGroup_Destroy $t %W"
+ bind $t <FocusIn> [list tkFocusGroup_In $t %W %d]
+ bind $t <FocusOut> [list tkFocusGroup_Out $t %W %d]
+ bind $t <Destroy> [list tkFocusGroup_Destroy $t %W]
}
}
@@ -185,7 +169,7 @@ proc tkFocusGroup_BindOut {t w cmd} {
proc tkFocusGroup_Destroy {t w} {
global tkPriv tkFocusIn tkFocusOut
- if {![string compare $t $w]} {
+ if {[string equal $t $w]} {
unset tkPriv(fg,$t)
unset tkPriv(focus,$t)
@@ -196,10 +180,9 @@ proc tkFocusGroup_Destroy {t w} {
unset tkFocusOut($name)
}
} else {
- if {[info exists tkPriv(focus,$t)]} {
- if {![string compare $tkPriv(focus,$t) $w]} {
- set tkPriv(focus,$t) ""
- }
+ if {[info exists tkPriv(focus,$t)] && \
+ [string equal $tkPriv(focus,$t) $w]} {
+ set tkPriv(focus,$t) ""
}
catch {
unset tkFocusIn($t,$w)
@@ -218,6 +201,12 @@ proc tkFocusGroup_Destroy {t w} {
proc tkFocusGroup_In {t w detail} {
global tkPriv tkFocusIn
+ 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 tkFocusIn($t,$w)]} {
set tkFocusIn($t,$w) ""
return
@@ -225,7 +214,7 @@ proc tkFocusGroup_In {t w detail} {
if {![info exists tkPriv(focus,$t)]} {
return
}
- if {![string compare $tkPriv(focus,$t) $w]} {
+ if {[string equal $tkPriv(focus,$t) $w]} {
# This is already in focus
#
return
@@ -245,8 +234,8 @@ proc tkFocusGroup_In {t w detail} {
proc tkFocusGroup_Out {t w detail} {
global tkPriv tkFocusOut
- if {[string compare $detail NotifyNonlinear] &&
- [string compare $detail NotifyNonlinearVirtual]} {
+ if {[string compare $detail NotifyNonlinear] && \
+ [string compare $detail NotifyNonlinearVirtual]} {
# This is caused by mouse moving out of the window
return
}
@@ -287,7 +276,7 @@ proc tkFDGetFileTypes {string} {
set name "$label ("
set sep ""
foreach ext $fileTypes($label) {
- if {![string compare $ext ""]} {
+ if {[string equal $ext ""]} {
continue
}
regsub {^[.]} $ext "*." ext
@@ -306,3 +295,5 @@ proc tkFDGetFileTypes {string} {
return $types
}
+
+
diff --git a/tk/library/console.tcl b/tk/library/console.tcl
index 673d842ef2f..de884118c8e 100644
--- a/tk/library/console.tcl
+++ b/tk/library/console.tcl
@@ -4,8 +4,9 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# SCCS: @(#) console.tcl 1.45 97/09/17 16:52:40
+# RCS: @(#) $Id$
#
+# Copyright (c) 1998-1999 Scriptics Corp.
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
@@ -23,14 +24,14 @@
proc tkConsoleInit {} {
global tcl_platform
- if {! [consoleinterp eval {set tcl_interactive}]} {
+ if {![consoleinterp eval {set tcl_interactive}]} {
wm withdraw .
}
- if {"$tcl_platform(platform)" == "macintosh"} {
- set mod "Cmd"
- } else {
+ if {[string compare $tcl_platform(platform) "macintosh"]} {
set mod "Ctrl"
+ } else {
+ set mod "Cmd"
}
menu .menubar
@@ -39,44 +40,49 @@ proc tkConsoleInit {} {
menu .menubar.file -tearoff 0
.menubar.file add command -label "Source..." -underline 0 \
- -command tkConsoleSource
+ -command tkConsoleSource
.menubar.file add command -label "Hide Console" -underline 0 \
- -command {wm withdraw .}
- if {"$tcl_platform(platform)" == "macintosh"} {
- .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
- } else {
+ -command {wm withdraw .}
+ if {[string compare $tcl_platform(platform) "macintosh"]} {
.menubar.file add command -label "Exit" -underline 1 -command exit
+ } else {
+ .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
}
menu .menubar.edit -tearoff 0
.menubar.edit add command -label "Cut" -underline 2 \
- -command { event generate .console <<Cut>> } -accel "$mod+X"
+ -command { event generate .console <<Cut>> } -accel "$mod+X"
.menubar.edit add command -label "Copy" -underline 0 \
- -command { event generate .console <<Copy>> } -accel "$mod+C"
+ -command { event generate .console <<Copy>> } -accel "$mod+C"
.menubar.edit add command -label "Paste" -underline 1 \
- -command { event generate .console <<Paste>> } -accel "$mod+V"
+ -command { event generate .console <<Paste>> } -accel "$mod+V"
- if {"$tcl_platform(platform)" == "windows"} {
+ if {[string compare $tcl_platform(platform) "windows"]} {
+ .menubar.edit add command -label "Clear" -underline 2 \
+ -command { event generate .console <<Clear>> }
+ } else {
.menubar.edit add command -label "Delete" -underline 0 \
- -command { event generate .console <<Clear>> } -accel "Del"
+ -command { event generate .console <<Clear>> } -accel "Del"
.menubar add cascade -label Help -menu .menubar.help -underline 0
menu .menubar.help -tearoff 0
.menubar.help add command -label "About..." -underline 0 \
- -command tkConsoleAbout
- } else {
- .menubar.edit add command -label "Clear" -underline 2 \
- -command { event generate .console <<Clear>> }
+ -command tkConsoleAbout
}
- . conf -menu .menubar
+ . configure -menu .menubar
text .console -yscrollcommand ".sb set" -setgrid true
scrollbar .sb -command ".console yview"
pack .sb -side right -fill both
pack .console -fill both -expand 1 -side left
- if {$tcl_platform(platform) == "macintosh"} {
- .console configure -font {Monaco 9 normal} -highlightthickness 0
+ switch -exact $tcl_platform(platform) {
+ "macintosh" {
+ .console configure -font {Monaco 9 normal} -highlightthickness 0
+ }
+ "windows" {
+ .console configure -font systemfixed
+ }
}
tkConsoleBind .console
@@ -106,7 +112,7 @@ proc tkConsoleSource {} {
set filename [tk_getOpenFile -defaultextension .tcl -parent . \
-title "Select a file to source" \
-filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}]
- if {"$filename" != ""} {
+ if {[string compare $filename ""]} {
set cmd [list source $filename]
if {[catch {consoleinterp eval $cmd} result]} {
tkConsoleOutput stderr "$result\n"
@@ -125,23 +131,23 @@ proc tkConsoleSource {} {
proc tkConsoleInvoke {args} {
set ranges [.console tag ranges input]
set cmd ""
- if {$ranges != ""} {
+ if {[llength $ranges]} {
set pos 0
- while {[lindex $ranges $pos] != ""} {
+ 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 {$cmd == ""} {
+ if {[string equal $cmd ""]} {
tkConsolePrompt
} elseif {[info complete $cmd]} {
.console mark set output end
.console tag delete input
set result [consoleinterp record $cmd]
- if {$result != ""} {
- .console insert insert "$result\n"
+ if {[string compare $result ""]} {
+ puts $result
}
tkConsoleHistory reset
tkConsolePrompt
@@ -189,7 +195,7 @@ proc tkConsoleHistory {cmd} {
} else {
set cmd "history event $histNum"
}
- if {$cmd != ""} {
+ if {[string compare $cmd ""]} {
catch {consoleinterp eval $cmd} cmd
}
.console delete promptEnd end
@@ -210,7 +216,7 @@ proc tkConsoleHistory {cmd} {
# partial - Flag to specify which prompt to print.
proc tkConsolePrompt {{partial normal}} {
- if {$partial == "normal"} {
+ if {[string equal $partial "normal"]} {
set temp [.console index "end - 1 char"]
.console mark set output end
if {[consoleinterp eval "info exists tcl_prompt1"]} {
@@ -268,21 +274,17 @@ proc tkConsoleBind {win} {
break
}
bind $win <Delete> {
- if {[%W tag nextrange sel 1.0 end] != ""} {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
%W tag remove sel sel.first promptEnd
- } else {
- if {[%W compare insert < promptEnd]} {
- break
- }
+ } elseif {[%W compare insert < promptEnd]} {
+ break
}
}
bind $win <BackSpace> {
- if {[%W tag nextrange sel 1.0 end] != ""} {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
%W tag remove sel sel.first promptEnd
- } else {
- if {[%W compare insert <= promptEnd]} {
- break
- }
+ } elseif {[%W compare insert <= promptEnd]} {
+ break
}
}
foreach left {Control-a Home} {
@@ -368,7 +370,7 @@ proc tkConsoleBind {win} {
}
bind $win <F9> {
eval destroy [winfo child .]
- if {$tcl_platform(platform) == "macintosh"} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
source -rsrc Console
} else {
source [file join $tk_library console.tcl]
@@ -416,7 +418,7 @@ proc tkConsoleBind {win} {
# s - The string to insert (usually just a single character)
proc tkConsoleInsert {w s} {
- if {$s == ""} {
+ if {[string equal $s ""]} {
return
}
catch {
@@ -470,7 +472,7 @@ proc tkConsoleExit {} {
proc tkConsoleAbout {} {
global tk_patchLevel
tk_messageBox -type ok -message "Tcl for Windows
-Copyright \251 1996 Sun Microsystems, Inc.
+Copyright \251 2000 Scriptics Corporation
Tcl [info patchlevel]
Tk $tk_patchLevel"
@@ -479,3 +481,5 @@ Tk $tk_patchLevel"
# now initialize the console
tkConsoleInit
+
+
diff --git a/tk/library/demos/README b/tk/library/demos/README
index c71f977d741..229c48707f2 100644
--- a/tk/library/demos/README
+++ b/tk/library/demos/README
@@ -43,4 +43,5 @@ browse - A simple directory browser. Invoke it with and argument
Double-click on files or subdirectories to browse them.
Control-c and control-q cause the program to exit.
-sccs id = SCCS: @(#) README 1.3 96/02/16 10:49:14
+RCS: @(#) $Id$
+
diff --git a/tk/library/demos/arrow.tcl b/tk/library/demos/arrow.tcl
index 126c17959c4..f3f00c1084c 100644
--- a/tk/library/demos/arrow.tcl
+++ b/tk/library/demos/arrow.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget that displays a
# large line with an arrowhead whose shape can be edited interactively.
#
-# SCCS: @(#) arrow.tcl 1.8 97/03/02 16:18:20
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -236,3 +236,4 @@ proc arrowMove3 {c x y} {
set v(width) $newWidth
}
}
+
diff --git a/tk/library/demos/bind.tcl b/tk/library/demos/bind.tcl
index 175be10b465..a55cb00d367 100644
--- a/tk/library/demos/bind.tcl
+++ b/tk/library/demos/bind.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a text widget with bindings set
# up for hypertext-like effects.
#
-# SCCS: @(#) bind.tcl 1.6 97/03/02 16:19:01
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -77,3 +77,4 @@ $w.text tag bind d6 <1> {source [file join $tk_library demos cscroll.tcl]}
$w.text mark set insert 0.0
$w.text configure -state disabled
+
diff --git a/tk/library/demos/bitmap.tcl b/tk/library/demos/bitmap.tcl
index 55f9e734946..5345b69ca05 100644
--- a/tk/library/demos/bitmap.tcl
+++ b/tk/library/demos/bitmap.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window that displays
# all of Tk's built-in bitmaps.
#
-# SCCS: @(#) bitmap.tcl 1.6 97/03/02 16:19:20
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -53,3 +53,4 @@ frame $w.frame
bitmapRow $w.frame.0 error gray12 gray25 gray50 gray75
bitmapRow $w.frame.1 hourglass info question questhead warning
pack $w.frame -side top -expand yes -fill both
+
diff --git a/tk/library/demos/browse b/tk/library/demos/browse
index 46f653264b5..af553105baf 100755
--- a/tk/library/demos/browse
+++ b/tk/library/demos/browse
@@ -7,7 +7,7 @@ exec wish "$0" "$@"
# directory and allows you to open files or subdirectories by
# double-clicking.
#
-# SCCS: @(#) browse 1.8 96/02/16 10:49:18
+# RCS: @(#) $Id$
# Create a scrollbar on the right side of the main window and a listbox
# on the left side.
@@ -54,3 +54,4 @@ foreach i [exec ls -a $dir] {
bind all <Control-c> {destroy .}
bind .list <Double-Button-1> {foreach i [selection get] {browse $dir $i}}
+
diff --git a/tk/library/demos/button.tcl b/tk/library/demos/button.tcl
index 8569b1dc5a6..651706db8d2 100644
--- a/tk/library/demos/button.tcl
+++ b/tk/library/demos/button.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing
# several button widgets.
#
-# SCCS: @(#) button.tcl 1.5 97/03/02 16:19:39
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -34,3 +34,4 @@ button $w.b3 -text "Sea Green" -width 10 \
button $w.b4 -text "Yellow" -width 10 \
-command "$w config -bg Yellow1; $w.buttons config -bg Yellow1"
pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2
+
diff --git a/tk/library/demos/check.tcl b/tk/library/demos/check.tcl
index 46e21b350eb..000ef61ae84 100644
--- a/tk/library/demos/check.tcl
+++ b/tk/library/demos/check.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing
# several checkbuttons.
#
-# SCCS: @(#) check.tcl 1.4 97/03/02 16:19:57
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -31,3 +31,4 @@ checkbutton $w.b1 -text "Wipers OK" -variable wipers -relief flat
checkbutton $w.b2 -text "Brakes OK" -variable brakes -relief flat
checkbutton $w.b3 -text "Driver Sober" -variable sober -relief flat
pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w
+
diff --git a/tk/library/demos/clrpick.tcl b/tk/library/demos/clrpick.tcl
index 757e0b84bc7..fc09ae44044 100644
--- a/tk/library/demos/clrpick.tcl
+++ b/tk/library/demos/clrpick.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script prompts the user to select a color.
#
-# SCCS: @(#) clrpick.tcl 1.3 97/03/02 16:20:12
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -54,3 +54,4 @@ proc setColor_helper {w options color} {
setColor_helper $child $options $color
}
}
+
diff --git a/tk/library/demos/colors.tcl b/tk/library/demos/colors.tcl
index e95c21c8b0a..9d95ed890a5 100644
--- a/tk/library/demos/colors.tcl
+++ b/tk/library/demos/colors.tcl
@@ -4,7 +4,7 @@
# many of the colors from the X color database. You can click on
# a color to change the application's palette.
#
-# SCCS: @(#) colors.tcl 1.4 97/03/02 16:20:29
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -99,3 +99,4 @@ $w.frame.list insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \
purple2 purple3 purple4 MediumPurple1 MediumPurple2 \
MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \
thistle4
+
diff --git a/tk/library/demos/cscroll.tcl b/tk/library/demos/cscroll.tcl
index 78f99fa93b9..5897dcb26cd 100644
--- a/tk/library/demos/cscroll.tcl
+++ b/tk/library/demos/cscroll.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a simple canvas that can be
# scrolled in two dimensions.
#
-# SCCS: @(#) cscroll.tcl 1.6 97/03/02 16:20:45
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -94,3 +94,4 @@ proc scrollButton canvas {
}
puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]"
}
+
diff --git a/tk/library/demos/ctext.tcl b/tk/library/demos/ctext.tcl
index fdd3f79a69e..83eac45e611 100644
--- a/tk/library/demos/ctext.tcl
+++ b/tk/library/demos/ctext.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget with a text
# item that can be edited and reconfigured in various ways.
#
-# SCCS: @(#) ctext.tcl 1.6 97/03/02 16:21:02
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -144,3 +144,4 @@ proc textDel {w} {
}
$w dchars text insert
}
+
diff --git a/tk/library/demos/dialog1.tcl b/tk/library/demos/dialog1.tcl
index e221beb2df4..63f97fef750 100644
--- a/tk/library/demos/dialog1.tcl
+++ b/tk/library/demos/dialog1.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script creates a dialog box with a local grab.
#
-# SCCS: @(#) dialog1.tcl 1.2 96/02/16 10:49:52
+# 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.} \
@@ -13,3 +13,4 @@ switch $i {
1 {puts "You pressed Cancel"}
2 {showCode .dialog1}
}
+
diff --git a/tk/library/demos/dialog2.tcl b/tk/library/demos/dialog2.tcl
index 0cc3bb6e1e7..6451c8dff45 100644
--- a/tk/library/demos/dialog2.tcl
+++ b/tk/library/demos/dialog2.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script creates a dialog box with a global grab.
#
-# SCCS: @(#) dialog2.tcl 1.2 96/02/16 10:49:53
+# RCS: @(#) $Id$
after idle {
.dialog2.msg configure -wraplength 4i
@@ -17,3 +17,4 @@ switch $i {
1 {puts "You pressed Cancel"}
2 {showCode .dialog2}
}
+
diff --git a/tk/library/demos/entry1.tcl b/tk/library/demos/entry1.tcl
index 0b68b682140..35d776c97b2 100644
--- a/tk/library/demos/entry1.tcl
+++ b/tk/library/demos/entry1.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates several entry widgets without
# scrollbars.
#
-# SCCS: @(#) entry1.tcl 1.5 97/03/02 16:22:10
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -34,3 +34,4 @@ $w.e1 insert 0 "Initial value"
$w.e2 insert end "This entry contains a long value, much too long "
$w.e2 insert end "to fit in the window at one time, so long in fact "
$w.e2 insert end "that you'll have to scan or scroll to see the end."
+
diff --git a/tk/library/demos/entry2.tcl b/tk/library/demos/entry2.tcl
index d9b67cd846b..cf5c16c6c6d 100644
--- a/tk/library/demos/entry2.tcl
+++ b/tk/library/demos/entry2.tcl
@@ -3,7 +3,7 @@
# This demonstration script is the same as the entry1.tcl script
# except that it creates scrollbars for the entries.
#
-# SCCS: @(#) entry2.tcl 1.5 97/03/02 16:22:24
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -46,3 +46,4 @@ $w.frame.e1 insert 0 "Initial value"
$w.frame.e2 insert end "This entry contains a long value, much too long "
$w.frame.e2 insert end "to fit in the window at one time, so long in fact "
$w.frame.e2 insert end "that you'll have to scan or scroll to see the end."
+
diff --git a/tk/library/demos/filebox.tcl b/tk/library/demos/filebox.tcl
index 83eeacc02b2..fdfff8aa061 100644
--- a/tk/library/demos/filebox.tcl
+++ b/tk/library/demos/filebox.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script prompts the user to select a file.
#
-# SCCS: @(#) filebox.tcl 1.3 97/03/02 16:22:36
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -68,3 +68,4 @@ proc fileDialog {w ent operation} {
$ent xview end
}
}
+
diff --git a/tk/library/demos/floor.tcl b/tk/library/demos/floor.tcl
index 30b62da2e2c..6c62d3a4aad 100644
--- a/tk/library/demos/floor.tcl
+++ b/tk/library/demos/floor.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widet that displays the
# floorplan for DEC's Western Research Laboratory.
#
-# SCCS: @(#) floor.tcl 1.6 97/03/02 16:23:32
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -1368,3 +1368,4 @@ bind $c <B2-Motion> "$c scan dragto %x %y"
bind $c <Destroy> "unset currentRoom"
set currentRoom ""
trace variable currentRoom w "roomChanged $c"
+
diff --git a/tk/library/demos/form.tcl b/tk/library/demos/form.tcl
index 3c43497cbe0..f50c06d3e17 100644
--- a/tk/library/demos/form.tcl
+++ b/tk/library/demos/form.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a simple form with a bunch
# of entry widgets.
#
-# SCCS: @(#) form.tcl 1.5 97/03/02 16:23:48
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -38,3 +38,4 @@ $w.f5.label config -text Phone:
pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
bind $w <Return> "destroy $w"
focus $w.f1.entry
+
diff --git a/tk/library/demos/hello b/tk/library/demos/hello
index 0fa5d05b837..ec8b798cd2d 100755
--- a/tk/library/demos/hello
+++ b/tk/library/demos/hello
@@ -6,7 +6,7 @@ exec wish "$0" "$@"
# Simple Tk script to create a button that prints "Hello, world".
# Click on the button to terminate the program.
#
-# SCCS: @(#) hello 1.6 96/02/16 10:49:18
+# RCS: @(#) $Id$
#
# The first line below creates the button, and the second line
# asks the packer to shrink-wrap the application's main window
@@ -16,3 +16,4 @@ button .hello -text "Hello, world" -command {
puts stdout "Hello, world"; destroy .
}
pack .hello
+
diff --git a/tk/library/demos/hscale.tcl b/tk/library/demos/hscale.tcl
index a760586046a..13bf81c70ff 100644
--- a/tk/library/demos/hscale.tcl
+++ b/tk/library/demos/hscale.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script shows an example with a horizontal scale.
#
-# SCCS: @(#) hscale.tcl 1.4 97/03/02 16:24:01
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -45,3 +45,4 @@ proc setWidth {w width} {
$w coords poly 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
$w coords line 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
}
+
diff --git a/tk/library/demos/icon.tcl b/tk/library/demos/icon.tcl
index 1c98fd478b7..fece907b5a6 100644
--- a/tk/library/demos/icon.tcl
+++ b/tk/library/demos/icon.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing
# buttons that display bitmaps instead of text.
#
-# SCCS: @(#) icon.tcl 1.8 97/03/02 16:24:19
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -50,3 +50,4 @@ radiobutton $w.frame.left.b4 \
-bitmap @[file join $tk_library demos images noletter.bmp] \
-variable letters -value empty
pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes
+
diff --git a/tk/library/demos/image1.tcl b/tk/library/demos/image1.tcl
index a3b78db92a0..30391f61b3e 100644
--- a/tk/library/demos/image1.tcl
+++ b/tk/library/demos/image1.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script displays two image widgets.
#
-# SCCS: @(#) image1.tcl 1.6 97/03/02 16:24:35
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -34,3 +34,4 @@ image create photo image1b \
label $w.l2 -image image1b -bd 1 -relief sunken
pack $w.l1 $w.l2 -side top -padx .5m -pady .5m
+
diff --git a/tk/library/demos/image2.tcl b/tk/library/demos/image2.tcl
index badea14fd32..827753cde2a 100644
--- a/tk/library/demos/image2.tcl
+++ b/tk/library/demos/image2.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a simple collection of widgets
# that allow you to select and view images in a Tk label.
#
-# SCCS: @(#) image2.tcl 1.9 97/03/02 16:24:48
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -78,3 +78,4 @@ frame $w.spacer2 -height 3m -width 20
label $w.imageLabel -text "Image:"
label $w.image -image image2a
pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w
+
diff --git a/tk/library/demos/images/mickey.gif b/tk/library/demos/images/mickey.gif
new file mode 100644
index 00000000000..91baba9795f
--- /dev/null
+++ b/tk/library/demos/images/mickey.gif
Binary files differ
diff --git a/tk/library/demos/items.tcl b/tk/library/demos/items.tcl
index 83e603375db..0f3ffde2eeb 100644
--- a/tk/library/demos/items.tcl
+++ b/tk/library/demos/items.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas that displays the
# canvas item types.
#
-# SCCS: @(#) items.tcl 1.16 97/03/02 16:25:05
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -283,3 +283,4 @@ proc butPress {w color} {
set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n]
after 500 "$w delete $i"
}
+
diff --git a/tk/library/demos/ixset b/tk/library/demos/ixset
index dcde75dbb1d..1e4716c2524 100755
--- a/tk/library/demos/ixset
+++ b/tk/library/demos/ixset
@@ -9,7 +9,7 @@ exec wish "$0" "$@"
# 91/11/23 : pda@masi.ibp.fr, jt@ratp.fr : design
# 92/08/01 : pda@masi.ibp.fr : cleaning
#
-# SCCS: @(#) ixset 1.7 96/02/16 10:49:19
+# RCS: @(#) $Id$
#
# Button actions
@@ -310,3 +310,4 @@ dispsettings
#
# Now, wait for user actions...
#
+
diff --git a/tk/library/demos/label.tcl b/tk/library/demos/label.tcl
index 2e0b0271f2e..63fe44e128a 100644
--- a/tk/library/demos/label.tcl
+++ b/tk/library/demos/label.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing
# several label widgets.
#
-# SCCS: @(#) label.tcl 1.7 97/03/02 16:25:27
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -38,3 +38,4 @@ label $w.right.bitmap -borderwidth 2 -relief sunken \
-bitmap @[file join $tk_library demos images face.bmp]
label $w.right.caption -text "Tcl/Tk Proprietor"
pack $w.right.bitmap $w.right.caption -side top
+
diff --git a/tk/library/demos/menu.tcl b/tk/library/demos/menu.tcl
index 78ec6256f17..9900cd59a1b 100644
--- a/tk/library/demos/menu.tcl
+++ b/tk/library/demos/menu.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubars.
#
-# SCCS: @(#) menu.tcl 1.17 97/06/26 15:45:04
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -150,3 +150,4 @@ bind Menu <<MenuSelect>> {
set menustatus $label
update idletasks
}
+
diff --git a/tk/library/demos/menubu.tcl b/tk/library/demos/menubu.tcl
index 2a76e302711..dc0681e55b3 100644
--- a/tk/library/demos/menubu.tcl
+++ b/tk/library/demos/menubu.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubuttons.
#
-# # SCCS: @(#) menubu.tcl 1.9 97/06/19 18:11:06
+# # RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -91,3 +91,4 @@ pack $body.buttons.colors -side left -padx 25 -pady 25
+
diff --git a/tk/library/demos/msgbox.tcl b/tk/library/demos/msgbox.tcl
index 52b648f89ab..73b7caa512d 100644
--- a/tk/library/demos/msgbox.tcl
+++ b/tk/library/demos/msgbox.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script creates message boxes of various type
#
-# SCCS: @(#) msgbox.tcl 1.3 97/03/02 16:26:07
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -63,3 +63,4 @@ proc showMessageBox {w} {
tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
-parent $w
}
+
diff --git a/tk/library/demos/plot.tcl b/tk/library/demos/plot.tcl
index 6067979806f..b226c84f2ae 100644
--- a/tk/library/demos/plot.tcl
+++ b/tk/library/demos/plot.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget showing a 2-D
# plot with data points that can be dragged with the mouse.
#
-# SCCS: @(#) plot.tcl 1.5 97/03/02 16:26:19
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -96,3 +96,4 @@ proc plotMove {w x y} {
set plot(lastX) $x
set plot(lastY) $y
}
+
diff --git a/tk/library/demos/puzzle.tcl b/tk/library/demos/puzzle.tcl
index 7e3d9c8d96c..0dcef217bd8 100644
--- a/tk/library/demos/puzzle.tcl
+++ b/tk/library/demos/puzzle.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a 15-puzzle game using a collection
# of buttons.
#
-# SCCS: @(#) puzzle.tcl 1.5 97/03/02 16:26:32
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -71,3 +71,4 @@ for {set i 0} {$i < 15} {set i [expr $i+1]} {
}
set xpos(space) .75
set ypos(space) .75
+
diff --git a/tk/library/demos/radio.tcl b/tk/library/demos/radio.tcl
index 2b73739e47d..91d9e8ecae8 100644
--- a/tk/library/demos/radio.tcl
+++ b/tk/library/demos/radio.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing
# several radiobutton widgets.
#
-# SCCS: @(#) radio.tcl 1.5 97/03/02 16:26:57
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -42,3 +42,4 @@ foreach color {Red Green Blue Yellow Orange Purple} {
-relief flat -value $lower
pack $w.right.$lower -side top -pady 2 -anchor w
}
+
diff --git a/tk/library/demos/rmt b/tk/library/demos/rmt
index 93104758988..de3ff853728 100755
--- a/tk/library/demos/rmt
+++ b/tk/library/demos/rmt
@@ -7,7 +7,7 @@ exec wish "$0" "$@"
# Tk applications. It allows you to select an application and
# then type commands to that application.
#
-# SCCS: @(#) rmt 1.10 96/06/24 16:42:38
+# RCS: @(#) $Id$
wm title . "Tk Remote Controller"
wm iconname . "Tk Remote"
@@ -203,3 +203,4 @@ proc fillAppsMenu {} {
set app [winfo name .]
prompt
focus .t
+
diff --git a/tk/library/demos/rolodex b/tk/library/demos/rolodex
index e3e0e5a2682..3e334f7ef70 100755
--- a/tk/library/demos/rolodex
+++ b/tk/library/demos/rolodex
@@ -8,7 +8,7 @@ exec wish "$0" "$@"
# feel of a rolodex program, although it's lifeless and doesn't
# actually do the rolodex application.
#
-# SCCS: @(#) rolodex 1.7 96/02/16 10:49:23
+# RCS: @(#) $Id$
foreach i [winfo child .] {
catch {destroy $i}
@@ -194,3 +194,4 @@ set helpTopics(version) {This is version 1.0.}
-underline 3
.menu.help.m add command -label "On Version..." -command {Help version} \
-underline 3
+
diff --git a/tk/library/demos/ruler.tcl b/tk/library/demos/ruler.tcl
index 3c77c72d455..e73e462fc46 100644
--- a/tk/library/demos/ruler.tcl
+++ b/tk/library/demos/ruler.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a canvas widget that displays a ruler
# with tab stops that can be set, moved, and deleted.
#
-# SCCS: @(#) ruler.tcl 1.9 97/03/02 16:17:33
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -171,3 +171,4 @@ proc rulerReleaseTab c {
$c dtag active
}
}
+
diff --git a/tk/library/demos/sayings.tcl b/tk/library/demos/sayings.tcl
index b4952c5f293..8f24ec907e8 100644
--- a/tk/library/demos/sayings.tcl
+++ b/tk/library/demos/sayings.tcl
@@ -4,7 +4,7 @@
# both horizontally and vertically. It displays a collection of
# well-known sayings.
#
-# SCCS: @(#) sayings.tcl 1.7 97/03/02 16:27:10
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -44,3 +44,4 @@ grid columnconfig $w.frame 0 -weight 1 -minsize 0
$w.frame.list insert 0 "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth"
+
diff --git a/tk/library/demos/search.tcl b/tk/library/demos/search.tcl
index ffefd823364..130cb53ee39 100644
--- a/tk/library/demos/search.tcl
+++ b/tk/library/demos/search.tcl
@@ -4,7 +4,7 @@
# allow you to load a file into a text widget, then perform searches
# on that file.
#
-# SCCS: @(#) search.tcl 1.5 97/03/02 16:27:25
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -139,3 +139,4 @@ $w.text mark set insert 0.0
set fileName ""
set searchString ""
+
diff --git a/tk/library/demos/square b/tk/library/demos/square
index 743016f9ea7..4a17ef14ef3 100755
--- a/tk/library/demos/square
+++ b/tk/library/demos/square
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
# Button-1 press/drag: moves square to mouse
# "a": toggle size animation on/off
#
-# SCCS: @(#) square 1.7 97/02/24 16:42:31
+# RCS: @(#) $Id$
square .s
pack .s -expand yes -fill both
@@ -53,3 +53,4 @@ proc timer {} {
.s size [expr {$s+$inc}]
after 30 timer
}
+
diff --git a/tk/library/demos/states.tcl b/tk/library/demos/states.tcl
index 23905a2d2b4..425c0bc582b 100644
--- a/tk/library/demos/states.tcl
+++ b/tk/library/demos/states.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a listbox widget that displays
# the names of the 50 states in the United States of America.
#
-# SCCS: @(#) states.tcl 1.4 97/03/02 16:27:37
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -43,3 +43,4 @@ $w.frame.list insert 0 Alabama Alaska Arizona Arkansas California \
"South Carolina" "South Dakota" \
Tennessee Texas Utah Vermont Virginia Washington \
"West Virginia" Wisconsin Wyoming
+
diff --git a/tk/library/demos/style.tcl b/tk/library/demos/style.tcl
index 6ed31f8004b..cf5d049cbec 100644
--- a/tk/library/demos/style.tcl
+++ b/tk/library/demos/style.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a text widget that illustrates the
# various display styles that may be set for tags.
#
-# SCCS: @(#) style.tcl 1.8 97/04/18 11:41:47
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -150,3 +150,4 @@ $w.text insert end "in this example.\n" spacing
$w.text insert end "To see where the space is, select ranges of " spacing
$w.text insert end "text within these paragraphs. The selection " spacing
$w.text insert end "highlight will cover the extra space." spacing
+
diff --git a/tk/library/demos/tcolor b/tk/library/demos/tcolor
index 50c0e6893a0..edef7235c93 100755
--- a/tk/library/demos/tcolor
+++ b/tk/library/demos/tcolor
@@ -7,7 +7,7 @@ exec wish "$0" "$@"
# create colors using either the RGB, HSB, or CYM color spaces
# and apply the color to existing applications.
#
-# SCCS: @(#) tcolor 1.11 96/06/24 16:43:11
+# RCS: @(#) $Id$
wm title . "Color Editor"
@@ -356,3 +356,4 @@ proc doUpdate {} {
}
changeColorSpace hsb
+
diff --git a/tk/library/demos/text.tcl b/tk/library/demos/text.tcl
index 97df78021f5..0cd2219c165 100644
--- a/tk/library/demos/text.tcl
+++ b/tk/library/demos/text.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a text widget that describes
# the basic editing functions.
#
-# SCCS: @(#) text.tcl 1.6 97/03/02 16:28:12
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -74,3 +74,4 @@ even number of characters high and wide. Also, if you make the window
narrow you can see that long lines automatically wrap around onto
additional lines so that all the information is always visible.}
$w.text mark set insert 0.0
+
diff --git a/tk/library/demos/timer b/tk/library/demos/timer
index b2edd114786..04a68f37f3e 100755
--- a/tk/library/demos/timer
+++ b/tk/library/demos/timer
@@ -5,7 +5,7 @@ exec wish "$0" "$@"
# timer --
# This script generates a counter with start and stop buttons.
#
-# SCCS: @(#) timer 1.6 96/02/16 10:49:20
+# RCS: @(#) $Id$
label .counter -text 0.00 -relief raised -width 10
button .start -text Start -command {
@@ -38,3 +38,4 @@ proc tick {} {
bind . <Control-c> {destroy .}
bind . <Control-q> {destroy .}
focus .
+
diff --git a/tk/library/demos/twind.tcl b/tk/library/demos/twind.tcl
index 75e732c6ac6..475cbd724bf 100644
--- a/tk/library/demos/twind.tcl
+++ b/tk/library/demos/twind.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a text widget with a bunch of
# embedded windows.
#
-# SCCS: @(#) twind.tcl 1.7 97/03/02 16:28:22
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -194,3 +194,4 @@ proc textWindDel w {
proc embDefBg t {
$t configure -background [lindex [$t configure -background] 3]
}
+
diff --git a/tk/library/demos/vscale.tcl b/tk/library/demos/vscale.tcl
index ed78ac09347..7f1afd2a780 100644
--- a/tk/library/demos/vscale.tcl
+++ b/tk/library/demos/vscale.tcl
@@ -2,7 +2,7 @@
#
# This demonstration script shows an example with a vertical scale.
#
-# SCCS: @(#) vscale.tcl 1.4 97/03/02 16:28:34
+# RCS: @(#) $Id$
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -46,3 +46,4 @@ proc setHeight {w height} {
$w coords poly 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
$w coords line 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
}
+
diff --git a/tk/library/demos/widget b/tk/library/demos/widget
index 05c89cdd2d1..eca4cb723c8 100755
--- a/tk/library/demos/widget
+++ b/tk/library/demos/widget
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
-# SCCS: @(#) widget 1.35 97/07/19 15:42:22
+# RCS: @(#) $Id$
eval destroy [winfo child .]
wm title . "Widget Demonstration"
@@ -389,3 +389,4 @@ proc aboutBox {} {
Copyright (c) 1996-1997 Sun Microsystems, Inc."
}
+
diff --git a/tk/library/dialog.tcl b/tk/library/dialog.tcl
index c1f8fbc034d..37dd66460bb 100644
--- a/tk/library/dialog.tcl
+++ b/tk/library/dialog.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# SCCS: @(#) dialog.tcl 1.33 97/06/06 11:20:04
+# RCS: @(#) $Id$
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -32,6 +32,18 @@
proc tk_dialog {w title text bitmap default args} {
global tkPriv tcl_platform
+ # 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.
@@ -41,19 +53,24 @@ proc tk_dialog {w title text bitmap default args} {
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW {set tkPriv(button) -1}
- # The following command means that the dialog won't be posted if
- # [winfo parent $w] is iconified, but it's really needed; otherwise
- # the dialog can become obscured by other windows in the application,
- # even though its grab keeps the rest of the application from being used.
-
- wm transient $w [winfo toplevel [winfo parent $w]]
- if {$tcl_platform(platform) == "macintosh"} {
+ # 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"]} {
unsupported1 style $w dBoxProc
}
frame $w.bot
frame $w.top
- if {$tcl_platform(platform) == "unix"} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
@@ -61,19 +78,21 @@ proc tk_dialog {w title text bitmap default args} {
pack $w.top -side top -fill both -expand 1
# 2. Fill the top part with bitmap and message (use the option
- # database for -wraplength so that it can be overridden by
- # the caller).
+ # database for -wraplength and -font so that they can be
+ # overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- label $w.msg -justify left -text $text
- if {$tcl_platform(platform) == "macintosh"} {
- $w.msg configure -font system
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ option add *Dialog.msg.font system widgetDefault
} else {
- $w.msg configure -font {Times 18}
+ 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 {$bitmap != ""} {
- if {($tcl_platform(platform) == "macintosh") && ($bitmap == "error")} {
+ if {[string compare $bitmap ""]} {
+ if {[string equal $tcl_platform(platform) "macintosh"] && \
+ [string equal $bitmap "error"]} {
set bitmap "stop"
}
label $w.bitmap -bitmap $bitmap
@@ -84,7 +103,7 @@ proc tk_dialog {w title text bitmap default args} {
set i 0
foreach but $args {
- button $w.button$i -text $but -command "set tkPriv(button) $i"
+ button $w.button$i -text $but -command [list set tkPriv(button) $i]
if {$i == $default} {
$w.button$i configure -default active
} else {
@@ -93,10 +112,10 @@ proc tk_dialog {w title text bitmap default args} {
grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew -padx 10
grid columnconfigure $w.bot $i
# We boost the size of some Mac buttons for l&f
- if {$tcl_platform(platform) == "macintosh"} {
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
set tmp [string tolower $but]
- if {($tmp == "ok") || ($tmp == "cancel")} {
- grid columnconfigure $w.bot $i -minsize [expr 59 + 20]
+ if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} {
+ grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]
}
}
incr i
@@ -107,10 +126,10 @@ proc tk_dialog {w title text bitmap default args} {
if {$default >= 0} {
bind $w <Return> "
- $w.button$default configure -state active -relief sunken
- update idletasks
- after 100
- set tkPriv(button) $default
+ [list $w.button$default] configure -state active -relief sunken
+ update idletasks
+ after 100
+ set tkPriv(button) $default
"
}
@@ -138,7 +157,7 @@ proc tk_dialog {w title text bitmap default args} {
set oldFocus [focus]
set oldGrab [grab current $w]
- if {$oldGrab != ""} {
+ if {[string compare $oldGrab ""]} {
set grabStatus [grab status $oldGrab]
}
grab $w
@@ -164,12 +183,14 @@ proc tk_dialog {w title text bitmap default args} {
bind $w <Destroy> {}
destroy $w
}
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
- grab -global $oldGrab
- } else {
+ if {[string compare $oldGrab ""]} {
+ if {[string compare $grabStatus "global"]} {
grab $oldGrab
+ } else {
+ grab -global $oldGrab
}
}
return $tkPriv(button)
}
+
+
diff --git a/tk/library/entry.tcl b/tk/library/entry.tcl
index e03b3c30aa7..594811a6108 100644
--- a/tk/library/entry.tcl
+++ b/tk/library/entry.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
-# SCCS: @(#) entry.tcl 1.49 97/09/17 19:08:48
+# RCS: @(#) $Id$
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -26,30 +26,31 @@
# 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 {set data [string range [%W get] [%W index sel.first]\
- [expr {[%W index sel.last] - 1}]]}]} {
+ if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {
clipboard clear -displayof %W
- clipboard append -displayof %W $data
+ clipboard append -displayof %W $tkPriv(data)
%W delete sel.first sel.last
+ unset tkPriv(data)
}
}
bind Entry <<Copy>> {
- if {![catch {set data [string range [%W get] [%W index sel.first]\
- [expr {[%W index sel.last] - 1}]]}]} {
+ if {![catch {tkEntryGetSelection %W} tkPriv(data)]} {
clipboard clear -displayof %W
- clipboard append -displayof %W $data
+ clipboard append -displayof %W $tkPriv(data)
+ unset tkPriv(data)
}
}
bind Entry <<Paste>> {
global tcl_platform
catch {
- if {"$tcl_platform(platform)" != "unix"} {
+ if {[string compare $tcl_platform(platform) "unix"]} {
catch {
%W delete sel.first sel.last
}
@@ -201,13 +202,13 @@ bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string equal $tcl_platform(platform) "macintosh"]} {
bind Entry <Command-KeyPress> {# nothing}
}
# On Windows, paste is done using Shift-Insert. Shift-Insert already
# generates the <<Paste>> event, so we don't need to do anything here.
-if {$tcl_platform(platform) != "windows"} {
+if {[string compare $tcl_platform(platform) "windows"]} {
bind Entry <Insert> {
catch {tkEntryInsert %W [selection get -displayof %W]}
}
@@ -335,7 +336,7 @@ proc tkEntryButton1 {w x} {
set tkPriv(pressX) $x
$w icursor [tkEntryClosestGap $w $x]
$w selection from insert
- if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkEntryMouseSelect --
@@ -405,7 +406,7 @@ proc tkEntryPaste {w x} {
$w icursor [tkEntryClosestGap $w $x]
catch {$w insert insert [selection get -displayof $w]}
- if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkEntryAutoScan --
@@ -429,7 +430,7 @@ proc tkEntryAutoScan {w} {
$w xview scroll -2 units
tkEntryMouseSelect $w $x
}
- set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
+ set tkPriv(afterId) [after 50 [list tkEntryAutoScan $w]]
}
# tkEntryKeySelect --
@@ -462,7 +463,7 @@ proc tkEntryKeySelect {w new} {
# s - The string to insert (usually just a single character)
proc tkEntryInsert {w s} {
- if {$s == ""} {
+ if {[string equal $s ""]} {
return
}
catch {
@@ -508,15 +509,8 @@ proc tkEntryBackspace w {
proc tkEntrySeeInsert w {
set c [$w index insert]
- set left [$w index @0]
- if {$left > $c} {
+ if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
$w xview $c
- return
- }
- set x [winfo width $w]
- while {([$w index @$x] <= $c) && ($left < $c)} {
- incr left
- $w xview $left
}
}
@@ -570,7 +564,7 @@ proc tkEntryTranspose w {
# w - The entry window in which the cursor is to move.
# start - Position at which to start search.
-if {$tcl_platform(platform) == "windows"} {
+if {[string equal $tcl_platform(platform) "windows"]} {
proc tkEntryNextWord {w start} {
set pos [tcl_endOfWord [$w get] [$w index $start]]
if {$pos >= 0} {
@@ -607,4 +601,19 @@ proc tkEntryPreviousWord {w start} {
}
return $pos
}
+# tkEntryGetSelection --
+#
+# Returns the selected text of the entry with respect to the -show option.
+#
+# Arguments:
+# w - The entry window from which the text to get
+
+proc tkEntryGetSelection {w} {
+ set entryString [string range [$w get] [$w index sel.first] \
+ [expr {[$w index sel.last] - 1}]]
+ if {[string compare [$w cget -show] ""]} {
+ regsub -all . $entryString [string index [$w cget -show] 0] entryString
+ }
+ return $entryString
+}
diff --git a/tk/library/focus.tcl b/tk/library/focus.tcl
index b4ff997dc43..8661245cdca 100644
--- a/tk/library/focus.tcl
+++ b/tk/library/focus.tcl
@@ -3,7 +3,7 @@
# This file defines several procedures for managing the input
# focus.
#
-# SCCS: @(#) focus.tcl 1.17 96/02/16 10:48:21
+# RCS: @(#) $Id$
#
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
@@ -24,7 +24,7 @@
proc tk_focusNext w {
set cur $w
- while 1 {
+ while {1} {
# Descend to just before the first child of the current widget.
@@ -34,11 +34,11 @@ proc tk_focusNext w {
# Look for the next sibling that isn't a top-level.
- while 1 {
+ while {1} {
incr i
if {$i < [llength $children]} {
set cur [lindex $children $i]
- if {[winfo toplevel $cur] == $cur} {
+ if {[string equal [winfo toplevel $cur] $cur]} {
continue
} else {
break
@@ -50,14 +50,14 @@ proc tk_focusNext w {
# look for its next sibling.
set cur $parent
- if {[winfo toplevel $cur] == $cur} {
+ 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 {($cur == $w) || [tkFocusOK $cur]} {
+ if {[string equal $w $cur] || [tkFocusOK $cur]} {
return $cur
}
}
@@ -76,13 +76,13 @@ proc tk_focusNext w {
proc tk_focusPrev w {
set cur $w
- while 1 {
+ while {1} {
# Collect information about the current window's position
# among its siblings. Also, if the window is a top-level,
# then reposition to just after the last child of the window.
-
- if {[winfo toplevel $cur] == $cur} {
+
+ if {[string equal [winfo toplevel $cur] $cur]} {
set parent $cur
set children [winfo children $cur]
set i [llength $children]
@@ -100,7 +100,7 @@ proc tk_focusPrev w {
while {$i > 0} {
incr i -1
set cur [lindex $children $i]
- if {[winfo toplevel $cur] == $cur} {
+ if {[string equal [winfo toplevel $cur] $cur]} {
continue
}
set parent $cur
@@ -108,7 +108,7 @@ proc tk_focusPrev w {
set i [llength $children]
}
set cur $parent
- if {($cur == $w) || [tkFocusOK $cur]} {
+ if {[string equal $w $cur] || [tkFocusOK $cur]} {
return $cur
}
}
@@ -136,7 +136,7 @@ proc tkFocusOK w {
} elseif {$value == 1} {
return [winfo viewable $w]
} else {
- set value [uplevel #0 $value $w]
+ set value [uplevel #0 $value [list $w]]
if {$value != ""} {
return $value
}
@@ -146,7 +146,7 @@ proc tkFocusOK w {
return 0
}
set code [catch {$w cget -state} value]
- if {($code == 0) && ($value == "disabled")} {
+ if {($code == 0) && [string equal $value "disabled"]} {
return 0
}
regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
@@ -165,16 +165,19 @@ proc tkFocusOK w {
proc tk_focusFollowsMouse {} {
set old [bind all <Enter>]
set script {
- if {("%d" == "NotifyAncestor") || ("%d" == "NotifyNonlinear")
- || ("%d" == "NotifyInferior")} {
- if {[tkFocusOK %W]} {
- focus %W
- }
+ if {[string equal "%d" "NotifyAncestor"] \
+ || [string equal "%d" "NotifyNonlinear"] \
+ || [string equal "%d" "NotifyInferior"]} {
+ if {[tkFocusOK %W]} {
+ focus %W
+ }
}
}
- if {$old != ""} {
+ if {[string compare $old ""]} {
bind all <Enter> "$old; $script"
} else {
bind all <Enter> $script
}
}
+
+
diff --git a/tk/library/folder.gif b/tk/library/folder.gif
new file mode 100644
index 00000000000..112bce7ab09
--- /dev/null
+++ b/tk/library/folder.gif
Binary files differ
diff --git a/tk/library/images/README b/tk/library/images/README
index 176b6e25997..1a8d7781726 100644
--- a/tk/library/images/README
+++ b/tk/library/images/README
@@ -1,6 +1,6 @@
README - images directory
-SCCS: @(#) README 1.1 97/08/06 13:19:19
+RCS: @(#) $Id$
This directory includes images for the Tcl Logo and the Tcl Powered
@@ -10,3 +10,4 @@ used to promote Tcl in your product documentation, web site or other
places you so desire.
+
diff --git a/tk/library/images/logo.eps b/tk/library/images/logo.eps
new file mode 100644
index 00000000000..0d05d3404bd
--- /dev/null
+++ b/tk/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/tk/library/images/pspbrwse.jbf b/tk/library/images/pspbrwse.jbf
new file mode 100755
index 00000000000..4b57f318bbd
--- /dev/null
+++ b/tk/library/images/pspbrwse.jbf
Binary files differ
diff --git a/tk/library/images/pwrdLogo.eps b/tk/library/images/pwrdLogo.eps
new file mode 100644
index 00000000000..e11d9e96451
--- /dev/null
+++ b/tk/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/tk/library/images/pwrdLogo100.gif b/tk/library/images/pwrdLogo100.gif
index 42c5b30a74f..d2f8cbb65d2 100644
--- a/tk/library/images/pwrdLogo100.gif
+++ b/tk/library/images/pwrdLogo100.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo150.gif b/tk/library/images/pwrdLogo150.gif
index e2e6b7af2db..89eec7ca7b3 100644
--- a/tk/library/images/pwrdLogo150.gif
+++ b/tk/library/images/pwrdLogo150.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo175.gif b/tk/library/images/pwrdLogo175.gif
index 67d9536686f..02dcd92dca4 100644
--- a/tk/library/images/pwrdLogo175.gif
+++ b/tk/library/images/pwrdLogo175.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo200.gif b/tk/library/images/pwrdLogo200.gif
index 6bff47246c5..66426bfd846 100644
--- a/tk/library/images/pwrdLogo200.gif
+++ b/tk/library/images/pwrdLogo200.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo75.gif b/tk/library/images/pwrdLogo75.gif
index 1c6b11a89ff..e75925c1894 100644
--- a/tk/library/images/pwrdLogo75.gif
+++ b/tk/library/images/pwrdLogo75.gif
Binary files differ
diff --git a/tk/library/images/tai-ku.gif b/tk/library/images/tai-ku.gif
new file mode 100644
index 00000000000..a5aea47599b
--- /dev/null
+++ b/tk/library/images/tai-ku.gif
Binary files differ
diff --git a/tk/library/listbox.tcl b/tk/library/listbox.tcl
index ddaafa76a43..f65b31e0a6f 100644
--- a/tk/library/listbox.tcl
+++ b/tk/library/listbox.tcl
@@ -3,10 +3,11 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# SCCS: @(#) listbox.tcl 1.21 97/06/10 17:13:55
+# 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.
@@ -119,6 +120,7 @@ bind Listbox <Control-Home> {
%W see 0
%W selection clear 0 end
%W selection set 0
+ event generate %W <<ListboxSelect>>
}
bind Listbox <Shift-Control-Home> {
tkListboxDataExtend %W 0
@@ -128,12 +130,13 @@ bind Listbox <Control-End> {
%W see end
%W selection clear 0 end
%W selection set end
+ event generate %W <<ListboxSelect>>
}
bind Listbox <Shift-Control-End> {
tkListboxDataExtend %W [%W index end]
}
bind Listbox <<Copy>> {
- if {[selection own -displayof %W] == "%W"} {
+ if {[string equal [selection own -displayof %W] "%W"]} {
clipboard clear -displayof %W
clipboard append -displayof %W [selection get -displayof %W]
}
@@ -157,8 +160,9 @@ bind Listbox <Control-slash> {
tkListboxSelectAll %W
}
bind Listbox <Control-backslash> {
- if {[%W cget -selectmode] != "browse"} {
+ if {[string compare [%W cget -selectmode] "browse"]} {
%W selection clear 0 end
+ event generate %W <<ListboxSelect>>
}
}
@@ -171,6 +175,31 @@ 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 "unix" $tcl_platform(platform)]} {
+ # 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
+ }
+ }
+}
+
# tkListboxBeginSelect --
#
# This procedure is typically invoked on button-1 presses. It begins
@@ -185,7 +214,7 @@ bind Listbox <B2-Motion> {
proc tkListboxBeginSelect {w el} {
global tkPriv
- if {[$w cget -selectmode] == "multiple"} {
+ if {[string equal [$w cget -selectmode] "multiple"]} {
if {[$w selection includes $el]} {
$w selection clear $el
} else {
@@ -198,6 +227,7 @@ proc tkListboxBeginSelect {w el} {
set tkPriv(listboxSelection) {}
set tkPriv(listboxPrev) $el
}
+ event generate $w <<ListboxSelect>>
}
# tkListboxMotion --
@@ -221,9 +251,14 @@ proc tkListboxMotion {w el} {
$w selection clear 0 end
$w selection set $el
set tkPriv(listboxPrev) $el
+ event generate $w <<ListboxSelect>>
}
extended {
set i $tkPriv(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
@@ -231,6 +266,9 @@ proc tkListboxMotion {w el} {
$w selection clear $i $el
$w selection clear anchor $el
}
+ if {![info exists tkPriv(listboxSelection)]} {
+ set tkPriv(listboxSelection) [$w curselection]
+ }
while {($i < $el) && ($i < $anchor)} {
if {[lsearch $tkPriv(listboxSelection) $i] >= 0} {
$w selection set $i
@@ -244,6 +282,7 @@ proc tkListboxMotion {w el} {
incr i -1
}
set tkPriv(listboxPrev) $el
+ event generate $w <<ListboxSelect>>
}
}
}
@@ -261,12 +300,11 @@ proc tkListboxMotion {w el} {
# one under the pointer). Must be in numerical form.
proc tkListboxBeginExtend {w el} {
- if {[$w cget -selectmode] == "extended"} {
+ if {[string equal [$w cget -selectmode] "extended"]} {
if {[$w selection includes anchor]} {
tkListboxMotion $w $el
} else {
# No selection yet; simulate the begin-select operation.
-
tkListboxBeginSelect $w $el
}
}
@@ -286,7 +324,7 @@ proc tkListboxBeginExtend {w el} {
proc tkListboxBeginToggle {w el} {
global tkPriv
- if {[$w cget -selectmode] == "extended"} {
+ if {[string equal [$w cget -selectmode] "extended"]} {
set tkPriv(listboxSelection) [$w curselection]
set tkPriv(listboxPrev) $el
$w selection anchor $el
@@ -295,6 +333,7 @@ proc tkListboxBeginToggle {w el} {
} else {
$w selection set $el
}
+ event generate $w <<ListboxSelect>>
}
}
@@ -325,7 +364,7 @@ proc tkListboxAutoScan {w} {
return
}
tkListboxMotion $w [$w index @$x,$y]
- set tkPriv(afterId) [after 50 tkListboxAutoScan $w]
+ set tkPriv(afterId) [after 50 [list tkListboxAutoScan $w]]
}
# tkListboxUpDown --
@@ -346,6 +385,7 @@ proc tkListboxUpDown {w amount} {
browse {
$w selection clear 0 end
$w selection set active
+ event generate $w <<ListboxSelect>>
}
extended {
$w selection clear 0 end
@@ -353,6 +393,7 @@ proc tkListboxUpDown {w amount} {
$w selection anchor active
set tkPriv(listboxPrev) [$w index active]
set tkPriv(listboxSelection) {}
+ event generate $w <<ListboxSelect>>
}
}
}
@@ -368,10 +409,16 @@ proc tkListboxUpDown {w amount} {
# amount - +1 to move down one item, -1 to move back one item.
proc tkListboxExtendUpDown {w amount} {
- if {[$w cget -selectmode] != "extended"} {
+ if {[string compare [$w cget -selectmode] "extended"]} {
return
}
- $w activate [expr {[$w index active] + $amount}]
+ set active [$w index active]
+ if {![info exists tkPriv(listboxSelection)]} {
+ global tkPriv
+ $w selection set $active
+ set tkPriv(listboxSelection) [$w curselection]
+ }
+ $w activate [expr {$active + $amount}]
$w see active
tkListboxMotion $w [$w index active]
}
@@ -389,13 +436,13 @@ proc tkListboxExtendUpDown {w amount} {
proc tkListboxDataExtend {w el} {
set mode [$w cget -selectmode]
- if {$mode == "extended"} {
+ if {[string equal $mode "extended"]} {
$w activate $el
$w see $el
if {[$w selection includes anchor]} {
tkListboxMotion $w $el
}
- } elseif {$mode == "multiple"} {
+ } elseif {[string equal $mode "multiple"]} {
$w activate $el
$w see $el
}
@@ -413,11 +460,15 @@ proc tkListboxDataExtend {w el} {
proc tkListboxCancel w {
global tkPriv
- if {[$w cget -selectmode] != "extended"} {
+ if {[string compare [$w cget -selectmode] "extended"]} {
return
}
set first [$w index anchor]
set last $tkPriv(listboxPrev)
+ if { [string equal $last ""] } {
+ # Not actually doing any selection right now
+ return
+ }
if {$first > $last} {
set tmp $first
set first $last
@@ -430,6 +481,7 @@ proc tkListboxCancel w {
}
incr first
}
+ event generate $w <<ListboxSelect>>
}
# tkListboxSelectAll
@@ -443,10 +495,13 @@ proc tkListboxCancel w {
proc tkListboxSelectAll w {
set mode [$w cget -selectmode]
- if {($mode == "single") || ($mode == "browse")} {
+ 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/tk/library/menu.tcl b/tk/library/menu.tcl
index b0fa2cce559..5e473b1dfe9 100644
--- a/tk/library/menu.tcl
+++ b/tk/library/menu.tcl
@@ -4,10 +4,11 @@
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
-# SCCS: @(#) menu.tcl 1.103 97/10/31 15:26:08
+# 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.
@@ -89,7 +90,7 @@ bind Menubutton <Leave> {
tkMbLeave %W
}
bind Menubutton <1> {
- if {$tkPriv(inMenubutton) != ""} {
+ if {[string compare $tkPriv(inMenubutton) ""]} {
tkMbPost $tkPriv(inMenubutton) %X %Y
}
}
@@ -118,9 +119,9 @@ bind Menu <FocusIn> {}
bind Menu <Enter> {
set tkPriv(window) %W
- if {[%W cget -type] == "tearoff"} {
- if {"%m" != "NotifyUngrab"} {
- if {$tcl_platform(platform) == "unix"} {
+ if {[string equal [%W cget -type] "tearoff"]} {
+ if {[string compare "%m" "NotifyUngrab"]} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
tk_menuSetFocus %W
}
}
@@ -168,7 +169,7 @@ bind Menu <KeyPress> {
# The following bindings apply to all windows, and are used to
# implement keyboard menu traversal.
-if {$tcl_platform(platform) == "unix"} {
+if {[string equal $tcl_platform(platform) "unix"]} {
bind all <Alt-KeyPress> {
tkTraverseToMenu %W %A
}
@@ -198,11 +199,11 @@ if {$tcl_platform(platform) == "unix"} {
proc tkMbEnter w {
global tkPriv
- if {$tkPriv(inMenubutton) != ""} {
+ if {[string compare $tkPriv(inMenubutton) ""]} {
tkMbLeave $tkPriv(inMenubutton)
}
set tkPriv(inMenubutton) $w
- if {[$w cget -state] != "disabled"} {
+ if {[string compare [$w cget -state] "disabled"]} {
$w configure -state active
}
}
@@ -221,7 +222,7 @@ proc tkMbLeave w {
if {![winfo exists $w]} {
return
}
- if {[$w cget -state] == "active"} {
+ if {[string equal [$w cget -state] "active"]} {
$w configure -state normal
}
}
@@ -242,20 +243,21 @@ proc tkMbPost {w {x {}} {y {}}} {
global tkPriv errorInfo
global tcl_platform
- if {([$w cget -state] == "disabled") || ($w == $tkPriv(postedMb))} {
+ if {[string equal [$w cget -state] "disabled"] || \
+ [string equal $w $tkPriv(postedMb)]} {
return
}
set menu [$w cget -menu]
- if {$menu == ""} {
+ if {[string equal $menu ""]} {
return
}
- set tearoff [expr {($tcl_platform(platform) == "unix") \
- || ([$menu cget -type] == "tearoff")}]
+ set tearoff [expr {[string equal $tcl_platform(platform) "unix"] \
+ || [string equal [$menu cget -type] "tearoff"]}]
if {[string first $w $menu] != 0} {
error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
}
set cur $tkPriv(postedMb)
- if {$cur != ""} {
+ if {[string compare $cur ""]} {
tkMenuUnpost {}
}
set tkPriv(cursor) [$w cget -cursor]
@@ -274,7 +276,7 @@ proc tkMbPost {w {x {}} {y {}}} {
update idletasks
if {[catch {
- switch [$w cget -direction] {
+ switch [$w cget -direction] {
above {
set x [winfo rootx $w]
set y [expr {[winfo rooty $w] - [winfo reqheight $menu]}]
@@ -299,7 +301,7 @@ proc tkMbPost {w {x {}} {y {}}} {
}
}
$menu post $x $y
- if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
+ if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
$menu activate $entry
tkGenerateMenuSelect $menu
}
@@ -318,14 +320,14 @@ proc tkMbPost {w {x {}} {y {}}} {
}
}
$menu post $x $y
- if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
+ if {[string compare $entry {}] && [string compare [$menu entrycget $entry -state] "disabled"]} {
$menu activate $entry
tkGenerateMenuSelect $menu
}
}
default {
if {[$w cget -indicatoron]} {
- if {$y == ""} {
+ if {[string equal $y {}]} {
set x [expr {[winfo rootx $w] + [winfo width $w]/2}]
set y [expr {[winfo rooty $w] + [winfo height $w]/2}]
}
@@ -334,8 +336,8 @@ proc tkMbPost {w {x {}} {y {}}} {
$menu post [winfo rootx $w] [expr {[winfo rooty $w]+[winfo height $w]}]
}
}
- }
- } msg]} {
+ }
+ } msg]} {
# Error posting menu (e.g. bogus -postcommand). Unpost it and
# reflect the error.
@@ -348,8 +350,10 @@ proc tkMbPost {w {x {}} {y {}}} {
set tkPriv(tearoff) $tearoff
if {$tearoff != 0} {
focus $menu
- tkSaveGrabInfo $w
- grab -global $w
+ if {[winfo viewable $w]} {
+ tkSaveGrabInfo $w
+ grab -global $w
+ }
}
}
@@ -385,25 +389,25 @@ proc tkMenuUnpost menu {
# what was posted.
catch {
- if {$mb != ""} {
+ if {[string compare $mb ""]} {
set menu [$mb cget -menu]
$menu unpost
set tkPriv(postedMb) {}
$mb configure -cursor $tkPriv(cursor)
$mb configure -relief $tkPriv(relief)
- } elseif {$tkPriv(popup) != ""} {
+ } elseif {[string compare $tkPriv(popup) ""]} {
$tkPriv(popup) unpost
set tkPriv(popup) {}
- } elseif {(!([$menu cget -type] == "menubar")
- && !([$menu cget -type] == "tearoff"))} {
+ } 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 {
+ while {1} {
set parent [winfo parent $menu]
- if {([winfo class $parent] != "Menu")
+ if {[string compare [winfo class $parent] "Menu"] \
|| ![winfo ismapped $parent]} {
break
}
@@ -411,33 +415,33 @@ proc tkMenuUnpost menu {
$parent postcascade none
tkGenerateMenuSelect $parent
set type [$parent cget -type]
- if {($type == "menubar")|| ($type == "tearoff")} {
+ if {[string equal $type "menubar"] || \
+ [string equal $type "tearoff"]} {
break
}
set menu $parent
}
- if {[$menu cget -type] != "menubar"} {
+ if {[string compare [$menu cget -type] "menubar"]} {
$menu unpost
}
}
}
- if {($tkPriv(tearoff) != 0) || ($tkPriv(menuBar) != "")} {
+ if {($tkPriv(tearoff) != 0) || [string compare $tkPriv(menuBar) ""]} {
# Release grab, if any, and restore the previous grab, if there
# was one.
-
- if {$menu != ""} {
+ if {[string compare $menu ""]} {
set grab [grab current $menu]
- if {$grab != ""} {
+ if {[string compare $grab ""]} {
grab release $grab
}
}
tkRestoreOldGrab
- if {$tkPriv(menuBar) != ""} {
+ if {[string compare $tkPriv(menuBar) ""]} {
$tkPriv(menuBar) configure -cursor $tkPriv(cursor)
set tkPriv(menuBar) {}
}
- if {$tcl_platform(platform) != "unix"} {
+ if {[string compare $tcl_platform(platform) "unix"]} {
set tkPriv(tearoff) 0
}
}
@@ -457,19 +461,21 @@ proc tkMenuUnpost menu {
proc tkMbMotion {w upDown rootx rooty} {
global tkPriv
- if {$tkPriv(inMenubutton) == $w} {
+ if {[string equal $tkPriv(inMenubutton) $w]} {
return
}
set new [winfo containing $rootx $rooty]
- if {($new != $tkPriv(inMenubutton)) && (($new == "")
- || ([winfo toplevel $new] == [winfo toplevel $w]))} {
- if {$tkPriv(inMenubutton) != ""} {
+ if {[string compare $new $tkPriv(inMenubutton)] \
+ && ([string equal $new ""] \
+ || [string equal [winfo toplevel $new] [winfo toplevel $w]])} {
+ if {[string compare $tkPriv(inMenubutton) ""]} {
tkMbLeave $tkPriv(inMenubutton)
}
- if {($new != "") && ([winfo class $new] == "Menubutton")
- && ([$new cget -indicatoron] == 0)
+ if {[string compare $new ""] \
+ && [string equal [winfo class $new] "Menubutton"] \
+ && ([$new cget -indicatoron] == 0) \
&& ([$w cget -indicatoron] == 0)} {
- if {$upDown == "down"} {
+ if {[string equal $upDown "down"]} {
tkMbPost $new $rootx $rooty
} else {
tkMbEnter $new
@@ -490,10 +496,12 @@ proc tkMbButtonUp w {
global tkPriv
global tcl_platform
- set tearoff [expr {($tcl_platform(platform) == "unix") \
- || ([[$w cget -menu] cget -type] == "tearoff")}]
- if {($tearoff != 0) && ($tkPriv(postedMb) == $w)
- && ($tkPriv(inMenubutton) == $w)} {
+ set menu [$w cget -menu]
+ set tearoff [expr {[string equal $tcl_platform(platform) "unix"] || \
+ ([string compare $menu {}] && \
+ [string equal [$menu cget -type] "tearoff"])}]
+ if {($tearoff != 0) && [string equal $tkPriv(postedMb) $w] \
+ && [string equal $tkPriv(inMenubutton) $w]} {
tkMenuFirstEntry [$tkPriv(postedMb) cget -menu]
} else {
tkMenuUnpost {}
@@ -515,10 +523,10 @@ proc tkMbButtonUp w {
proc tkMenuMotion {menu x y state} {
global tkPriv
- if {$menu == $tkPriv(window)} {
- if {[$menu cget -type] == "menubar"} {
+ if {[string equal $menu $tkPriv(window)]} {
+ if {[string equal [$menu cget -type] "menubar"]} {
if {[info exists tkPriv(focus)] && \
- ([string compare $menu $tkPriv(focus)] != 0)} {
+ [string compare $menu $tkPriv(focus)]} {
$menu activate @$x,$y
tkGenerateMenuSelect $menu
}
@@ -550,17 +558,22 @@ proc tkMenuMotion {menu x y state} {
proc tkMenuButtonDown menu {
global tkPriv
global tcl_platform
+
+ if {![winfo viewable $menu]} {
+ return
+ }
$menu postcascade active
- if {$tkPriv(postedMb) != ""} {
+ if {[string compare $tkPriv(postedMb) ""] && \
+ [winfo viewable $tkPriv(postedMb)]} {
grab -global $tkPriv(postedMb)
} else {
- while {([$menu cget -type] == "normal")
- && ([winfo class [winfo parent $menu]] == "Menu")
+ 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 {$tkPriv(menuBar) == {}} {
+ if {[string equal $tkPriv(menuBar) {}]} {
set tkPriv(menuBar) $menu
set tkPriv(cursor) [$menu cget -cursor]
$menu configure -cursor arrow
@@ -571,14 +584,14 @@ proc tkMenuButtonDown menu {
# restore the grab, since the old grab window will not be viewable
# anymore.
- if {$menu != [grab current $menu]} {
+ if {[string compare $menu [grab current $menu]]} {
tkSaveGrabInfo $menu
}
# Must re-grab even if the grab window hasn't changed, in order
# to release the implicit grab from the button press.
- if {$tcl_platform(platform) == "unix"} {
+ if {[string equal $tcl_platform(platform) "unix"]} {
grab -global $menu
}
}
@@ -597,12 +610,12 @@ proc tkMenuButtonDown menu {
proc tkMenuLeave {menu rootx rooty state} {
global tkPriv
set tkPriv(window) {}
- if {[$menu index active] == "none"} {
+ if {[string equal [$menu index active] "none"]} {
return
}
- if {([$menu type active] == "cascade")
- && ([winfo containing $rootx $rooty]
- == [$menu entrycget active -menu])} {
+ if {[string equal [$menu type active] "cascade"]
+ && [string equal [winfo containing $rootx $rooty] \
+ [$menu entrycget active -menu]]} {
return
}
$menu activate none
@@ -622,7 +635,7 @@ proc tkMenuLeave {menu rootx rooty state} {
proc tkMenuInvoke {w buttonRelease} {
global tkPriv
- if {$buttonRelease && ($tkPriv(window) == "")} {
+ if {$buttonRelease && [string equal $tkPriv(window) {}]} {
# Mouse was pressed over a menu without a menu button, then
# dragged off the menu (possibly with a cascade posted) and
# released. Unpost everything and quit.
@@ -633,18 +646,36 @@ proc tkMenuInvoke {w buttonRelease} {
tkMenuUnpost $w
return
}
- if {[$w type active] == "cascade"} {
+ if {[string equal [$w type active] "cascade"]} {
$w postcascade active
set menu [$w entrycget active -menu]
tkMenuFirstEntry $menu
- } elseif {[$w type active] == "tearoff"} {
- tkMenuUnpost $w
+ } elseif {[string equal [$w type active] "tearoff"]} {
tkTearOffMenu $w
- } elseif {[$w cget -type] == "menubar"} {
+ tkMenuUnpost $w
+ } elseif {[string equal [$w cget -type] "menubar"]} {
$w postcascade none
- $w activate none
- event generate $w <<MenuSelect>>
+ 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>>
+ }
+
tkMenuUnpost $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 {
tkMenuUnpost $w
uplevel #0 [list $w invoke active]
@@ -661,9 +692,9 @@ proc tkMenuInvoke {w buttonRelease} {
proc tkMenuEscape menu {
set parent [winfo parent $menu]
- if {([winfo class $parent] != "Menu")} {
+ if {[string compare [winfo class $parent] "Menu"]} {
tkMenuUnpost $menu
- } elseif {([$parent cget -type] == "menubar")} {
+ } elseif {[string equal [$parent cget -type] "menubar"]} {
tkMenuUnpost $menu
tkRestoreOldGrab
} else {
@@ -675,7 +706,7 @@ proc tkMenuEscape menu {
# differently depending on whether the menu is a menu bar or not.
proc tkMenuUpArrow {menu} {
- if {[$menu cget -type] == "menubar"} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextMenu $menu left
} else {
tkMenuNextEntry $menu -1
@@ -683,7 +714,7 @@ proc tkMenuUpArrow {menu} {
}
proc tkMenuDownArrow {menu} {
- if {[$menu cget -type] == "menubar"} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextMenu $menu right
} else {
tkMenuNextEntry $menu 1
@@ -691,7 +722,7 @@ proc tkMenuDownArrow {menu} {
}
proc tkMenuLeftArrow {menu} {
- if {[$menu cget -type] == "menubar"} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextEntry $menu -1
} else {
tkMenuNextMenu $menu left
@@ -699,7 +730,7 @@ proc tkMenuLeftArrow {menu} {
}
proc tkMenuRightArrow {menu} {
- if {[$menu cget -type] == "menubar"} {
+ if {[string equal [$menu cget -type] "menubar"]} {
tkMenuNextEntry $menu 1
} else {
tkMenuNextMenu $menu right
@@ -721,22 +752,22 @@ proc tkMenuNextMenu {menu direction} {
# First handle traversals into and out of cascaded menus.
- if {$direction == "right"} {
+ if {[string equal $direction "right"]} {
set count 1
set parent [winfo parent $menu]
set class [winfo class $parent]
- if {[$menu type active] == "cascade"} {
+ if {[string equal [$menu type active] "cascade"]} {
$menu postcascade active
set m2 [$menu entrycget active -menu]
- if {$m2 != ""} {
+ if {[string compare $m2 ""]} {
tkMenuFirstEntry $m2
}
return
} else {
set parent [winfo parent $menu]
- while {($parent != ".")} {
- if {([winfo class $parent] == "Menu")
- && ([$parent cget -type] == "menubar")} {
+ while {[string compare $parent "."]} {
+ if {[string equal [winfo class $parent] "Menu"] \
+ && [string equal [$parent cget -type] "menubar"]} {
tk_menuSetFocus $parent
tkMenuNextEntry $parent 1
return
@@ -747,8 +778,8 @@ proc tkMenuNextMenu {menu direction} {
} else {
set count -1
set m2 [winfo parent $menu]
- if {[winfo class $m2] == "Menu"} {
- if {[$m2 cget -type] != "menubar"} {
+ if {[string equal [winfo class $m2] "Menu"]} {
+ if {[string compare [$m2 cget -type] "menubar"]} {
$menu activate none
tkGenerateMenuSelect $menu
tk_menuSetFocus $m2
@@ -767,8 +798,8 @@ proc tkMenuNextMenu {menu direction} {
# or previous menubutton, if that makes sense.
set m2 [winfo parent $menu]
- if {[winfo class $m2] == "Menu"} {
- if {[$m2 cget -type] == "menubar"} {
+ if {[string equal [winfo class $m2] "Menu"]} {
+ if {[string equal [$m2 cget -type] "menubar"]} {
tk_menuSetFocus $m2
tkMenuNextEntry $m2 -1
return
@@ -776,13 +807,13 @@ proc tkMenuNextMenu {menu direction} {
}
set w $tkPriv(postedMb)
- if {$w == ""} {
+ 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 {1} {
while {$i < 0} {
incr i $length
}
@@ -790,13 +821,13 @@ proc tkMenuNextMenu {menu direction} {
incr i -$length
}
set mb [lindex $buttons $i]
- if {([winfo class $mb] == "Menubutton")
- && ([$mb cget -state] != "disabled")
- && ([$mb cget -menu] != "")
- && ([[$mb cget -menu] index last] != "none")} {
+ 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 {$mb == $w} {
+ if {[string equal $mb $w]} {
return
}
incr i $count
@@ -817,18 +848,18 @@ proc tkMenuNextMenu {menu direction} {
proc tkMenuNextEntry {menu count} {
global tkPriv
- if {[$menu index last] == "none"} {
+ if {[string equal [$menu index last] "none"]} {
return
}
set length [expr {[$menu index last]+1}]
set quitAfter $length
set active [$menu index active]
- if {$active == "none"} {
+ if {[string equal $active "none"]} {
set i 0
} else {
set i [expr {$active + $count}]
}
- while 1 {
+ 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.
@@ -842,7 +873,7 @@ proc tkMenuNextEntry {menu count} {
incr i -$length
}
if {[catch {$menu entrycget $i -state} state] == 0} {
- if {$state != "disabled"} {
+ if {[string compare $state "disabled"]} {
break
}
}
@@ -854,9 +885,12 @@ proc tkMenuNextEntry {menu count} {
}
$menu activate $i
tkGenerateMenuSelect $menu
- if {[$menu type $i] == "cascade"} {
+ if {[string equal [$menu type $i] "cascade"]} {
set cascade [$menu entrycget $i -menu]
- if {[string compare $cascade ""] != 0} {
+ 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
tkMenuFirstEntry $cascade
}
@@ -885,39 +919,46 @@ proc tkMenuFind {w char} {
set windowlist [winfo child $w]
foreach child $windowlist {
- switch [winfo class $child] {
- Menu {
- if {[$child cget -type] == "menubar"} {
- if {$char == ""} {
+ # Don't descend into other toplevels.
+ if {[string compare [winfo toplevel [focus]] \
+ [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
}
- set last [$child index last]
- for {set i [$child cget -tearoff]} {$i <= $last} {incr i} {
- if {[$child type $i] == "separator"} {
- continue
- }
- set char2 [string index [$child entrycget $i -label] \
- [$child entrycget $i -underline]]
- if {([string compare $char [string tolower $char2]] \
- == 0) || ($char == "")} {
- if {[$child entrycget $i -state] != "disabled"} {
- return $child
- }
- }
- }
}
}
}
}
foreach child $windowlist {
+ # Don't descend into other toplevels.
+ if {[string compare [winfo toplevel [focus]] \
+ [winfo toplevel $child]]} {
+ continue
+ }
switch [winfo class $child] {
Menubutton {
set char2 [string index [$child cget -text] \
[$child cget -underline]]
- if {([string compare $char [string tolower $char2]] == 0)
- || ($char == "")} {
- if {[$child cget -state] != "disabled"} {
+ if {[string equal $char [string tolower $char2]] \
+ || [string equal $char ""]} {
+ if {[string compare [$child cget -state] "disabled"]} {
return $child
}
}
@@ -925,7 +966,7 @@ proc tkMenuFind {w char} {
default {
set match [tkMenuFind $child $char]
- if {$match != ""} {
+ if {[string compare $match ""]} {
return $match
}
}
@@ -948,21 +989,22 @@ proc tkMenuFind {w char} {
proc tkTraverseToMenu {w char} {
global tkPriv
- if {$char == ""} {
+ if {[string equal $char ""]} {
return
}
- while {[winfo class $w] == "Menu"} {
- if {([$w cget -type] != "menubar") && ($tkPriv(postedMb) == "")} {
+ while {[string equal [winfo class $w] "Menu"]} {
+ if {[string compare [$w cget -type] "menubar"] \
+ && [string equal $tkPriv(postedMb) ""]} {
return
}
- if {[$w cget -type] == "menubar"} {
+ if {[string equal [$w cget -type] "menubar"]} {
break
}
set w [winfo parent $w]
}
set w [tkMenuFind [winfo toplevel $w] $char]
- if {$w != ""} {
- if {[winfo class $w] == "Menu"} {
+ if {[string compare $w ""]} {
+ if {[string equal [winfo class $w] "Menu"]} {
tk_menuSetFocus $w
set tkPriv(window) $w
tkSaveGrabInfo $w
@@ -985,8 +1027,8 @@ proc tkTraverseToMenu {w char} {
proc tkFirstMenu w {
set w [tkMenuFind [winfo toplevel $w] ""]
- if {$w != ""} {
- if {[winfo class $w] == "Menu"} {
+ if {[string compare $w ""]} {
+ if {[string equal [winfo class $w] "Menu"]} {
tk_menuSetFocus $w
set tkPriv(window) $w
tkSaveGrabInfo $w
@@ -1011,27 +1053,26 @@ proc tkFirstMenu w {
# nothing happens.
proc tkTraverseWithinMenu {w char} {
- if {$char == ""} {
+ if {[string equal $char ""]} {
return
}
set char [string tolower $char]
set last [$w index last]
- if {$last == "none"} {
+ 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]]}]} {
+ [$w entrycget $i -label] [$w entrycget $i -underline]]}]} {
continue
}
- if {[string compare $char [string tolower $char2]] == 0} {
- if {[$w type $i] == "cascade"} {
+ 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 {$m2 != ""} {
+ if {[string compare $m2 ""]} {
tkMenuFirstEntry $m2
}
} else {
@@ -1055,25 +1096,31 @@ proc tkTraverseWithinMenu {w char} {
# menu - Name of the menu window (possibly empty).
proc tkMenuFirstEntry menu {
- if {$menu == ""} {
+ if {[string equal $menu ""]} {
return
}
tk_menuSetFocus $menu
- if {[$menu index active] != "none"} {
+ if {[string compare [$menu index active] "none"]} {
return
}
set last [$menu index last]
- if {$last == "none"} {
+ if {[string equal $last "none"]} {
return
}
for {set i 0} {$i <= $last} {incr i} {
- if {([catch {set state [$menu entrycget $i -state]}] == 0)
- && ($state != "disabled") && ([$menu type $i] != "tearoff")} {
+ if {([catch {set state [$menu entrycget $i -state]}] == 0) \
+ && [string compare $state "disabled"] \
+ && [string compare [$menu type $i] "tearoff"]} {
$menu activate $i
tkGenerateMenuSelect $menu
- if {[$menu type $i] == "cascade"} {
+ # 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 ""] != 0} {
+ if {[string compare $cascade ""]} {
$menu postcascade $i
tkMenuFirstEntry $cascade
}
@@ -1101,12 +1148,12 @@ proc tkMenuFindName {menu s} {
return $i
}
set last [$menu index last]
- if {$last == "none"} {
+ if {[string equal $last "none"]} {
return
}
for {set i 0} {$i <= $last} {incr i} {
if {![catch {$menu entrycget $i -label} label]} {
- if {$label == $s} {
+ if {[string equal $label $s]} {
return $i
}
}
@@ -1129,7 +1176,7 @@ proc tkMenuFindName {menu s} {
proc tkPostOverPoint {menu x y {entry {}}} {
global tcl_platform
- if {$entry != {}} {
+ if {[string compare $entry {}]} {
if {$entry == [$menu index last]} {
incr y [expr {-([$menu yposition $entry] \
+ [winfo reqheight $menu])/2}]
@@ -1140,7 +1187,8 @@ proc tkPostOverPoint {menu x y {entry {}}} {
incr x [expr {-[winfo reqwidth $menu]/2}]
}
$menu post $x $y
- if {($entry != {}) && ([$menu entrycget $entry -state] != "disabled")} {
+ if {[string compare $entry {}] \
+ && [string compare [$menu entrycget $entry -state] "disabled"]} {
$menu activate $entry
tkGenerateMenuSelect $menu
}
@@ -1157,7 +1205,7 @@ proc tkPostOverPoint {menu x y {entry {}}} {
proc tkSaveGrabInfo w {
global tkPriv
set tkPriv(oldGrab) [grab current $w]
- if {$tkPriv(oldGrab) != ""} {
+ if {[string compare $tkPriv(oldGrab) ""]} {
set tkPriv(grabStatus) [grab status $tkPriv(oldGrab)]
}
}
@@ -1169,13 +1217,13 @@ proc tkSaveGrabInfo w {
proc tkRestoreOldGrab {} {
global tkPriv
- if {$tkPriv(oldGrab) != ""} {
+ if {[string compare $tkPriv(oldGrab) ""]} {
# Be careful restoring the old grab, since it's window may not
# be visible anymore.
catch {
- if {$tkPriv(grabStatus) == "global"} {
+ if {[string equal $tkPriv(grabStatus) "global"]} {
grab set -global $tkPriv(oldGrab)
} else {
grab set $tkPriv(oldGrab)
@@ -1187,7 +1235,7 @@ proc tkRestoreOldGrab {} {
proc tk_menuSetFocus {menu} {
global tkPriv
- if {![info exists tkPriv(focus)] || [string length $tkPriv(focus)] == 0} {
+ if {![info exists tkPriv(focus)] || [string equal $tkPriv(focus) {}]} {
set tkPriv(focus) [focus]
}
focus $menu
@@ -1196,9 +1244,8 @@ proc tk_menuSetFocus {menu} {
proc tkGenerateMenuSelect {menu} {
global tkPriv
- if {([string compare $tkPriv(activeMenu) $menu] == 0) \
- && ([string compare $tkPriv(activeItem) [$menu index active]] \
- == 0)} {
+ if {[string equal $tkPriv(activeMenu) $menu] \
+ && [string equal $tkPriv(activeItem) [$menu index active]]} {
return
}
@@ -1222,14 +1269,18 @@ proc tkGenerateMenuSelect {menu} {
proc tk_popup {menu x y {entry {}}} {
global tkPriv
global tcl_platform
- if {($tkPriv(popup) != "") || ($tkPriv(postedMb) != "")} {
+ if {[string compare $tkPriv(popup) ""] \
+ || [string compare $tkPriv(postedMb) ""]} {
tkMenuUnpost {}
}
tkPostOverPoint $menu $x $y $entry
- if {$tcl_platform(platform) == "unix"} {
- tkSaveGrabInfo $menu
+ if {[string equal $tcl_platform(platform) "unix"] \
+ && [winfo viewable $menu]} {
+ tkSaveGrabInfo $menu
grab -global $menu
set tkPriv(popup) $menu
tk_menuSetFocus $menu
}
}
+
+
diff --git a/tk/library/msgbox.tcl b/tk/library/msgbox.tcl
index e892ea5ce23..1e6744f629f 100644
--- a/tk/library/msgbox.tcl
+++ b/tk/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# SCCS: @(#) msgbox.tcl 1.8 97/07/28 17:20:01
+# RCS: @(#) $Id$
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -11,6 +11,108 @@
# 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};"
# tkMessageBox --
#
@@ -20,13 +122,16 @@
# 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 tkMessageBox {args} {
- global tkPriv tcl_platform
+ global tkPriv tcl_platform tk_strictMotif
set w tkPrivMsgBox
upvar #0 $w data
@@ -49,16 +154,14 @@ proc tkMessageBox {args} {
tclParseConfigSpec $w $specs "" $args
- if {[lsearch {info warning error question} $data(-icon)] == -1} {
- error "invalid icon \"$data(-icon)\", must be error, info, question or warning"
+ if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
+ error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
}
- if {$tcl_platform(platform) == "macintosh"} {
- if {$data(-icon) == "error"} {
- set data(-icon) "stop"
- } elseif {$data(-icon) == "warning"} {
- set data(-icon) "caution"
- } elseif {$data(-icon) == "info"} {
- set data(-icon) "note"
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ switch -- $data(-icon) {
+ "error" {set data(-icon) "stop"}
+ "warning" {set data(-icon) "caution"}
+ "info" {set data(-icon) "note"}
}
}
@@ -66,7 +169,7 @@ proc tkMessageBox {args} {
error "bad window path name \"$data(-parent)\""
}
- case $data(-type) {
+ switch -- $data(-type) {
abortretryignore {
set buttons {
{abort -width 6 -text Abort -under 0}
@@ -78,7 +181,7 @@ proc tkMessageBox {args} {
set buttons {
{ok -width 6 -text OK -under 0}
}
- if {$data(-default) == ""} {
+ if {[string equal $data(-default) ""]} {
set data(-default) "ok"
}
}
@@ -108,14 +211,14 @@ proc tkMessageBox {args} {
}
}
default {
- error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel"
+ error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
}
}
if {[string compare $data(-default) ""]} {
set valid 0
foreach btn $buttons {
- if {![string compare [lindex $btn 0] $data(-default)]} {
+ if {[string equal [lindex $btn 0] $data(-default)]} {
set valid 1
break
}
@@ -142,8 +245,19 @@ proc tkMessageBox {args} {
wm title $w $data(-title)
wm iconname $w Dialog
wm protocol $w WM_DELETE_WINDOW { }
- wm transient $w $data(-parent)
- if {$tcl_platform(platform) == "macintosh"} {
+
+ # 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 $tcl_platform(platform) "macintosh"]} {
unsupported1 style $w dBoxProc
}
@@ -151,25 +265,65 @@ proc tkMessageBox {args} {
pack $w.bot -side bottom -fill both
frame $w.top
pack $w.top -side top -fill both -expand 1
- if {$tcl_platform(platform) != "macintosh"} {
+ if {[string compare $tcl_platform(platform) "macintosh"]} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
# 4. Fill the top part with bitmap and message (use the option
- # database for -wraplength so that it can be overridden by
- # the caller).
+ # database for -wraplength and -font so that they can be
+ # overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- label $w.msg -justify left -text $data(-message)
- catch {$w.msg configure -font \
- -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
+ if {[string equal $tcl_platform(platform) "macintosh"]} {
+ option add *Dialog.msg.font system widgetDefault
+ } else {
+ option add *Dialog.msg.font {Times 18} widgetDefault
}
- pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
- if {$data(-icon) != ""} {
- label $w.bitmap -bitmap $data(-icon)
- pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
+
+ label $w.msg -anchor nw -justify left -text $data(-message)
+ if {[string compare $data(-icon) ""]} {
+ if {[string equal $tcl_platform(platform) "macintosh"] \
+ || ([winfo depth $w] < 4) || $tk_strictMotif} {
+ label $w.bitmap -bitmap $data(-icon)
+ } else {
+ canvas $w.bitmap -width 32 -height 32 -highlightthickness 0
+ 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.
@@ -177,29 +331,26 @@ proc tkMessageBox {args} {
foreach but $buttons {
set name [lindex $but 0]
set opts [lrange $but 1 end]
- if {![string compare $opts {}]} {
+ if {![llength $opts]} {
# Capitalize the first letter of $name
- set capName \
- [string toupper \
- [string index $name 0]][string range $name 1 end]
+ set capName [string toupper $name 0]
set opts [list -text $capName]
}
- eval button $w.$name $opts -command [list "set tkPriv(button) $name"]
+ eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
- if {![string compare $name $data(-default)]} {
+ if {[string equal $name $data(-default)]} {
$w.$name configure -default active
}
- pack $w.$name -in $w.bot -side left -expand 1 \
- -padx 3m -pady 2m
+ pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
# create the binding for the key accelerator, based on the underline
#
set underIdx [$w.$name cget -under]
if {$underIdx >= 0} {
set key [string index [$w.$name cget -text] $underIdx]
- bind $w <Alt-[string tolower $key]> "$w.$name invoke"
- bind $w <Alt-[string toupper $key]> "$w.$name invoke"
+ bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
+ bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
}
# CYGNUS LOCAL - bind all buttons so that <Return>
@@ -209,44 +360,41 @@ proc tkMessageBox {args} {
incr i
}
- # 6. Create a binding for <Return> on the dialog if there is a
- # default button.
+ 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
+ }
+ }
+ }
- # CYGNUS LOCAL - This seems like a bad idea. If the user
- # uses the keyboard to select something other than the default and
- # then hits <Return> to activate that button, the wrong value will
- # be returned
+ # 6. Create a binding for <Return> on the dialog
- #if [string compare $data(-default) ""] {
- #bind $w <Return> "tkButtonInvoke $w.$data(-default)"
- #}
+ bind $w <Return> {
+ if {[string equal Button [winfo class %W]]} {
+ tkButtonInvoke %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.
- 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
+ ::tk::PlaceWindow $w widget $data(-parent)
# 8. Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {$oldGrab != ""} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
if {[string compare $data(-default) ""]} {
- focus $w.$data(-default)
+ set focus $w.$data(-default)
} else {
- focus $w
+ 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
@@ -255,14 +403,10 @@ proc tkMessageBox {args} {
# restore any grab that was in effect.
tkwait variable tkPriv(button)
- catch {focus $oldFocus}
- destroy $w
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
+
+ ::tk::RestoreFocusGrab $w $focus
+
return $tkPriv(button)
}
+
+
diff --git a/tk/library/obsolete.tcl b/tk/library/obsolete.tcl
index 7fc1fb366f3..78774297929 100644
--- a/tk/library/obsolete.tcl
+++ b/tk/library/obsolete.tcl
@@ -3,7 +3,7 @@
# This file contains obsolete procedures that people really shouldn't
# be using anymore, but which are kept around for backward compatibility.
#
-# SCCS: @(#) obsolete.tcl 1.3 96/02/16 10:48:19
+# RCS: @(#) $Id$
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
@@ -19,3 +19,4 @@
proc tk_menuBar args {}
proc tk_bindForTraversal args {}
+
diff --git a/tk/library/optMenu.tcl b/tk/library/optMenu.tcl
index bf9768c425d..6a84755760e 100644
--- a/tk/library/optMenu.tcl
+++ b/tk/library/optMenu.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_optionMenu, which creates
# an option button and its associated menu.
#
-# SCCS: @(#) optMenu.tcl 1.11 97/08/22 14:21:13
+# RCS: @(#) $Id$
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
@@ -43,3 +43,4 @@ proc tk_optionMenu {w varName firstValue args} {
}
return $w.menu
}
+
diff --git a/tk/library/palette.tcl b/tk/library/palette.tcl
index 3fb2c084b73..3f90d830eba 100644
--- a/tk/library/palette.tcl
+++ b/tk/library/palette.tcl
@@ -3,7 +3,7 @@
# This file contains procedures that change the color palette used
# by Tk.
#
-# SCCS: @(#) palette.tcl 1.11 97/06/23 20:35:44
+# RCS: @(#) $Id$
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
#
@@ -24,6 +24,11 @@
# 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
+ }
+
global tkPalette
# Create an array that has the complete new palette. If some colors
@@ -95,8 +100,8 @@ proc tk_setPalette {args} {
# defaults are currently for this platform.
toplevel .___tk_set_palette
wm withdraw .___tk_set_palette
- foreach q {button canvas checkbutton entry frame label listbox menubutton menu message \
- radiobutton scale scrollbar text} {
+ foreach q {button canvas checkbutton entry frame label listbox \
+ menubutton menu message radiobutton scale scrollbar text} {
$q .___tk_set_palette.$q
}
@@ -189,23 +194,22 @@ proc tkRecolorTree {w colors} {
# by 10%.
proc tkDarken {color percent} {
- set l [winfo rgb . $color]
- set red [expr {[lindex $l 0]/256}]
- set green [expr {[lindex $l 1]/256}]
- set blue [expr {[lindex $l 2]/256}]
- set red [expr {($red*$percent)/100}]
+ 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
}
- set green [expr {($green*$percent)/100}]
if {$green > 255} {
set green 255
}
- set blue [expr {($blue*$percent)/100}]
if {$blue > 255} {
set blue 255
}
- format #%02x%02x%02x $red $green $blue
+ return [format "#%02x%02x%02x" $red $green $blue]
}
# tk_bisque --
@@ -222,3 +226,4 @@ proc tk_bisque {} {
selectBackground #e6ceb1 selectForeground black \
troughColor #cdb79e
}
+
diff --git a/tk/library/safetk.tcl b/tk/library/safetk.tcl
index 40482ec4a1a..e8ca616eed4 100644
--- a/tk/library/safetk.tcl
+++ b/tk/library/safetk.tcl
@@ -2,7 +2,7 @@
#
# Support procs to use Tk in safe interpreters.
#
-# SCCS: @(#) safetk.tcl 1.8 97/10/29 14:59:16
+# RCS: @(#) $Id$
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
@@ -22,7 +22,7 @@
#
# We use opt (optional arguments parsing)
-package require opt 0.1;
+package require opt 0.4.1;
namespace eval ::safe {
@@ -37,6 +37,11 @@ namespace eval ::safe {
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 [eval [list file join] [file split $tk_library]]
+
# Clear Tk's access for that interp (path).
allowTk $slave $argv
@@ -48,7 +53,7 @@ namespace eval ::safe {
# 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;
+ return $slave
}
@@ -62,65 +67,83 @@ namespace eval ::safe {
# 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"
- }
+::tcl::OptProc loadTk {
+ {slave -interp "name of the slave interpreter"}
+ {-use -windowId {} "window Id to use (new toplevel otherwise)"}
+ {-display -displayName {} "display name to use (current one otherwise)"}
+} {
+ set displayGiven [::tcl::OptProcArgGiven "-display"]
+ if {!$displayGiven} {
+
+ # Try to get the current display from "."
+ # (which might not exist if the master is tk-less)
+
+ if {[catch {set display [winfo screen .]}]} {
+ if {[info exists ::env(DISPLAY)]} {
+ set display $::env(DISPLAY)
+ } else {
+ Log $slave "no winfo screen . nor env(DISPLAY)" WARNING
+ set display ":0.0"
}
}
- if {![::tcl::OptProcArgGiven "-use"]} {
- # create a decorated toplevel
- ::tcl::Lassign [tkTopLevel $slave $display] w use;
- # set our delete hook (slave arg is added by interpDelete)
- Set [DeleteHookName $slave] [list tkDelete {} $w];
+ }
+ 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 {
- # 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]
+
+ # 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 {
- # 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
- }
+
+ # 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
- }
+ }
+ 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
+ # Prepares the slave for tk with those parameters
+
+ tkInterpInit $slave [list "-use" $use "-display" $display]
+
+ load {} Tk $slave
- return $slave
- }
+ return $slave
+}
proc ::safe::TkInit {interpPath} {
variable tkInit
@@ -135,70 +158,122 @@ proc ::safe::TkInit {interpPath} {
}
}
+# 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
}
- 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;
+
+# 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";
+ 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)";
+ safe slave \"$slave\" ($msg)"
}
Log $slave "New toplevel $w" NOTICE
set msg "Untrusted Tcl applet ($slave)"
- wm title $w $msg;
+ wm title $w $msg
# Control frame
set wc $w.fc
- frame $wc -bg red -borderwidth 3 -relief ridge ;
+ 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];
+ bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave]
- label $wc.l -text $msg \
- -padx 2 -pady 0 -anchor w;
+ 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 ;
+ 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 ;
+ 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;
+ 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] ;
+ list $w [winfo id $w.c]
}
}
+
+
diff --git a/tk/library/scale.tcl b/tk/library/scale.tcl
index f6bb4d307bb..54199d4bc06 100644
--- a/tk/library/scale.tcl
+++ b/tk/library/scale.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk scale widgets and provides
# procedures that help in implementing the bindings.
#
-# SCCS: @(#) scale.tcl 1.12 96/04/16 11:42:25
+# RCS: @(#) $Id$
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -32,7 +32,7 @@ bind Scale <Leave> {
if {$tk_strictMotif} {
%W config -activebackground $tkPriv(activeBg)
}
- if {[%W cget -state] == "active"} {
+ if {[string equal [%W cget -state] "active"]} {
%W configure -state normal
}
}
@@ -106,14 +106,16 @@ bind Scale <End> {
# x, y - Mouse coordinates.
proc tkScaleActivate {w x y} {
- global tkPriv
- if {[$w cget -state] == "disabled"} {
- return;
+ if {[string equal [$w cget -state] "disabled"]} {
+ return
}
- if {[$w identify $x $y] == "slider"} {
- $w configure -state active
+ if {[string equal [$w identify $x $y] "slider"]} {
+ set state active
} else {
- $w configure -state normal
+ set state normal
+ }
+ if {[string compare [$w cget -state] $state]} {
+ $w configure -state $state
}
}
@@ -129,11 +131,11 @@ proc tkScaleButtonDown {w x y} {
global tkPriv
set tkPriv(dragging) 0
set el [$w identify $x $y]
- if {$el == "trough1"} {
+ if {[string equal $el "trough1"]} {
tkScaleIncrement $w up little initial
- } elseif {$el == "trough2"} {
+ } elseif {[string equal $el "trough2"]} {
tkScaleIncrement $w down little initial
- } elseif {$el == "slider"} {
+ } elseif {[string equal $el "slider"]} {
set tkPriv(dragging) 1
set tkPriv(initValue) [$w get]
set coords [$w coords]
@@ -158,8 +160,7 @@ proc tkScaleDrag {w x y} {
if {!$tkPriv(dragging)} {
return
}
- $w set [$w get [expr {$x - $tkPriv(deltaX)}] \
- [expr {$y - $tkPriv(deltaY)}]]
+ $w set [$w get [expr {$x-$tkPriv(deltaX)}] [expr {$y-$tkPriv(deltaY)}]]
}
# tkScaleEndDrag --
@@ -194,7 +195,7 @@ proc tkScaleEndDrag {w} {
proc tkScaleIncrement {w dir big repeat} {
global tkPriv
if {![winfo exists $w]} return
- if {$big == "big"} {
+ 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}]
@@ -205,19 +206,19 @@ proc tkScaleIncrement {w dir big repeat} {
} else {
set inc [$w cget -resolution]
}
- if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} {
+ if {([$w cget -from] > [$w cget -to]) ^ [string equal $dir "up"]} {
set inc [expr {-$inc}]
}
$w set [expr {[$w get] + $inc}]
- if {$repeat == "again"} {
+ if {[string equal $repeat "again"]} {
set tkPriv(afterId) [after [$w cget -repeatinterval] \
- tkScaleIncrement $w $dir $big again]
- } elseif {$repeat == "initial"} {
+ [list tkScaleIncrement $w $dir $big again]]
+ } elseif {[string equal $repeat "initial"]} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
set tkPriv(afterId) [after $delay \
- tkScaleIncrement $w $dir $big again]
+ [list tkScaleIncrement $w $dir $big again]]
}
}
}
@@ -233,9 +234,9 @@ proc tkScaleIncrement {w dir big repeat} {
proc tkScaleControlPress {w x y} {
set el [$w identify $x $y]
- if {$el == "trough1"} {
+ if {[string equal $el "trough1"]} {
$w set [$w cget -from]
- } elseif {$el == "trough2"} {
+ } elseif {[string equal $el "trough2"]} {
$w set [$w cget -to]
}
}
@@ -252,8 +253,8 @@ proc tkScaleControlPress {w x y} {
proc tkScaleButton2Down {w x y} {
global tkPriv
- if {[$w cget -state] == "disabled"} {
- return;
+ if {[string equal [$w cget -state] "disabled"]} {
+ return
}
$w configure -state active
$w set [$w get $x $y]
@@ -263,3 +264,5 @@ proc tkScaleButton2Down {w x y} {
set tkPriv(deltaX) 0
set tkPriv(deltaY) 0
}
+
+
diff --git a/tk/library/scrlbar.tcl b/tk/library/scrlbar.tcl
index 6073e746c6e..2659d820c0a 100644
--- a/tk/library/scrlbar.tcl
+++ b/tk/library/scrlbar.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
-# SCCS: @(#) scrlbar.tcl 1.26 96/11/30 17:19:16
+# RCS: @(#) $Id$
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -17,8 +17,9 @@
#-------------------------------------------------------------------------
# Standard Motif bindings:
-if {($tcl_platform(platform) != "windows") &&
- ($tcl_platform(platform) != "macintosh")} {
+if {[string compare $tcl_platform(platform) "windows"] && \
+ [string compare $tcl_platform(platform) "macintosh"]} {
+
bind Scrollbar <Enter> {
if {$tk_strictMotif} {
set tkPriv(activeBg) [%W cget -activebackground]
@@ -144,7 +145,7 @@ proc tkScrollButtonDown {w x y} {
set tkPriv(relief) [$w cget -activerelief]
$w configure -activerelief sunken
set element [$w identify $x $y]
- if {$element == "slider"} {
+ if {[string equal $element "slider"]} {
tkScrollStartDrag $w $x $y
} else {
tkScrollSelect $w $element initial
@@ -163,9 +164,12 @@ proc tkScrollButtonDown {w x y} {
proc tkScrollButtonUp {w x y} {
global tkPriv
tkCancelRepeat
- $w configure -activerelief $tkPriv(relief)
- tkScrollEndDrag $w $x $y
- $w activate [$w identify $x $y]
+ if {[info exists tkPriv(relief)]} {
+ # Avoid error due to spurious release events
+ $w configure -activerelief $tkPriv(relief)
+ tkScrollEndDrag $w $x $y
+ $w activate [$w identify $x $y]
+ }
}
# tkScrollSelect --
@@ -185,24 +189,21 @@ proc tkScrollButtonUp {w x y} {
proc tkScrollSelect {w element repeat} {
global tkPriv
if {![winfo exists $w]} return
- if {$element == "arrow1"} {
- tkScrollByUnits $w hv -1
- } elseif {$element == "trough1"} {
- tkScrollByPages $w hv -1
- } elseif {$element == "trough2"} {
- tkScrollByPages $w hv 1
- } elseif {$element == "arrow2"} {
- tkScrollByUnits $w hv 1
- } else {
- return
+ switch -- $element {
+ "arrow1" {tkScrollByUnits $w hv -1}
+ "trough1" {tkScrollByPages $w hv -1}
+ "trough2" {tkScrollByPages $w hv 1}
+ "arrow2" {tkScrollByUnits $w hv 1}
+ default {return}
}
- if {$repeat == "again"} {
+ if {[string equal $repeat "again"]} {
set tkPriv(afterId) [after [$w cget -repeatinterval] \
- tkScrollSelect $w $element again]
- } elseif {$repeat == "initial"} {
+ [list tkScrollSelect $w $element again]]
+ } elseif {[string equal $repeat "initial"]} {
set delay [$w cget -repeatdelay]
if {$delay > 0} {
- set tkPriv(afterId) [after $delay tkScrollSelect $w $element again]
+ set tkPriv(afterId) [after $delay \
+ [list tkScrollSelect $w $element again]]
}
}
}
@@ -218,7 +219,7 @@ proc tkScrollSelect {w element repeat} {
proc tkScrollStartDrag {w x y} {
global tkPriv
- if {[$w cget -command] == ""} {
+ if {[string equal [$w cget -command] ""]} {
return
}
set tkPriv(pressX) $x
@@ -227,13 +228,11 @@ proc tkScrollStartDrag {w x y} {
set iv0 [lindex $tkPriv(initValues) 0]
if {[llength $tkPriv(initValues)] == 2} {
set tkPriv(initPos) $iv0
+ } elseif {$iv0 == 0} {
+ set tkPriv(initPos) 0.0
} else {
- if {$iv0 == 0} {
- set tkPriv(initPos) 0.0
- } else {
- set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \
- / [lindex $tkPriv(initValues) 0]}]
- }
+ set tkPriv(initPos) [expr {(double([lindex $tkPriv(initValues) 2])) \
+ / [lindex $tkPriv(initValues) 0]}]
}
}
@@ -250,7 +249,7 @@ proc tkScrollStartDrag {w x y} {
proc tkScrollDrag {w x y} {
global tkPriv
- if {$tkPriv(initPos) == ""} {
+ if {[string equal $tkPriv(initPos) ""]} {
return
}
set delta [$w delta [expr {$x - $tkPriv(pressX)}] [expr {$y - $tkPriv(pressY)}]]
@@ -260,7 +259,7 @@ proc tkScrollDrag {w x y} {
[expr {[lindex $tkPriv(initValues) 1] + $delta}]
} else {
set delta [expr {round($delta * [lindex $tkPriv(initValues) 0])}]
- eval $w set [lreplace $tkPriv(initValues) 2 3 \
+ eval [list $w] set [lreplace $tkPriv(initValues) 2 3 \
[expr {[lindex $tkPriv(initValues) 2] + $delta}] \
[expr {[lindex $tkPriv(initValues) 3] + $delta}]]
}
@@ -280,7 +279,7 @@ proc tkScrollDrag {w x y} {
proc tkScrollEndDrag {w x y} {
global tkPriv
- if {$tkPriv(initPos) == ""} {
+ if {[string equal $tkPriv(initPos) ""]} {
return
}
if {[$w cget -jump]} {
@@ -304,7 +303,7 @@ proc tkScrollEndDrag {w x y} {
proc tkScrollByUnits {w orient amount} {
set cmd [$w cget -command]
- if {($cmd == "") || ([string first \
+ if {[string equal $cmd ""] || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
return
}
@@ -312,7 +311,7 @@ proc tkScrollByUnits {w orient amount} {
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount units
} else {
- uplevel #0 $cmd [expr [lindex $info 2] + $amount]
+ uplevel #0 $cmd [expr {[lindex $info 2] + $amount}]
}
}
@@ -329,7 +328,7 @@ proc tkScrollByUnits {w orient amount} {
proc tkScrollByPages {w orient amount} {
set cmd [$w cget -command]
- if {($cmd == "") || ([string first \
+ if {[string equal $cmd ""] || ([string first \
[string index [$w cget -orient] 0] $orient] < 0)} {
return
}
@@ -337,7 +336,7 @@ proc tkScrollByPages {w orient amount} {
if {[llength $info] == 2} {
uplevel #0 $cmd scroll $amount pages
} else {
- uplevel #0 $cmd [expr [lindex $info 2] + $amount*([lindex $info 1] - 1)]
+ uplevel #0 $cmd [expr {[lindex $info 2] + $amount*([lindex $info 1] - 1)}]
}
}
@@ -353,14 +352,14 @@ proc tkScrollByPages {w orient amount} {
proc tkScrollToPos {w pos} {
set cmd [$w cget -command]
- if {($cmd == "")} {
+ 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)]
+ uplevel #0 $cmd [expr {round([lindex $info 0]*$pos)}]
}
}
@@ -399,7 +398,7 @@ proc tkScrollTopBottom {w x y} {
proc tkScrollButton2Down {w x y} {
global tkPriv
set element [$w identify $x $y]
- if {($element == "arrow1") || ($element == "arrow2")} {
+ if {[string match {arrow[12]} $element]} {
tkScrollButtonDown $w $x $y
return
}
@@ -415,3 +414,4 @@ proc tkScrollButton2Down {w x y} {
$w activate slider
tkScrollStartDrag $w $x $y
}
+
diff --git a/tk/library/tclIndex b/tk/library/tclIndex
index e2cf7f1109b..659e0125e26 100644
--- a/tk/library/tclIndex
+++ b/tk/library/tclIndex
@@ -201,26 +201,26 @@ set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]
set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::tk::dialog::file::tkFDialog) [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::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(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]
-set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]
+set auto_index(::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::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(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]
@@ -242,3 +242,4 @@ set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]
set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tk::dialog::file::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]]
diff --git a/tk/library/tearoff.tcl b/tk/library/tearoff.tcl
index 91b4ff21614..e2e7204299a 100644
--- a/tk/library/tearoff.tcl
+++ b/tk/library/tearoff.tcl
@@ -2,7 +2,7 @@
#
# This file contains procedures that implement tear-off menus.
#
-# SCCS: @(#) tearoff.tcl 1.20 97/08/21 14:49:27
+# RCS: @(#) $Id$
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -40,11 +40,11 @@ proc tkTearOffMenu {w {x 0} {y 0}} {
}
set parent [winfo parent $w]
- while {([winfo toplevel $parent] != $parent)
- || ([winfo class $parent] == "Menu")} {
+ while {[string compare [winfo toplevel $parent] $parent] \
+ || [string equal [winfo class $parent] "Menu"]} {
set parent [winfo parent $parent]
}
- if {$parent == "."} {
+ if {[string equal $parent "."]} {
set parent ""
}
for {set i 1} 1 {incr i} {
@@ -61,7 +61,7 @@ proc tkTearOffMenu {w {x 0} {y 0}} {
# entry. If it's a menubutton then use its text.
set parent [winfo parent $w]
- if {[$menu cget -title] != ""} {
+ if {[string compare [$menu cget -title] ""]} {
wm title $menu [$menu cget -title]
} else {
switch [winfo class $parent] {
@@ -92,8 +92,8 @@ proc tkTearOffMenu {w {x 0} {y 0}} {
# now.
set cmd [$w cget -tearoffcommand]
- if {$cmd != ""} {
- uplevel #0 $cmd $w $menu
+ if {[string compare $cmd ""]} {
+ uplevel #0 $cmd [list $w $menu]
}
return $menu
}
@@ -114,14 +114,14 @@ proc tkMenuDup {src dst type} {
if {[llength $option] == 2} {
continue
}
- if {[string compare [lindex $option 0] "-type"] == 0} {
+ if {[string equal [lindex $option 0] "-type"]} {
continue
}
lappend cmd [lindex $option 0] [lindex $option 4]
}
eval $cmd
set last [$src index last]
- if {$last == "none"} {
+ if {[string equal $last "none"]} {
return
}
for {set i [$src cget -tearoff]} {$i <= $last} {incr i} {
@@ -134,12 +134,34 @@ proc tkMenuDup {src dst type} {
# Duplicate the binding tags and bindings from the source menu.
- regsub -all . $src {\\&} quotedSrc
- regsub -all . $dst {\\&} quotedDst
- regsub -all $quotedSrc [bindtags $src] $dst x
+ 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] {
- regsub -all $quotedSrc [bind $src $event] $dst x
+ 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/tk/library/text.tcl b/tk/library/text.tcl
index 0c96f27f32c..7e68e669499 100644
--- a/tk/library/text.tcl
+++ b/tk/library/text.tcl
@@ -3,10 +3,11 @@
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
-# SCCS: @(#) text.tcl 1.58 97/09/17 18:54:56
+# 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.
@@ -52,12 +53,14 @@ bind Text <B1-Motion> {
bind Text <Double-1> {
set tkPriv(selectMode) word
tkTextSelectTo %W %x %y
- catch {%W mark set insert sel.first}
+ catch {%W mark set insert sel.last}
+ catch {%W mark set anchor sel.first}
}
bind Text <Triple-1> {
set tkPriv(selectMode) line
tkTextSelectTo %W %x %y
- catch {%W mark set insert sel.first}
+ catch {%W mark set insert sel.last}
+ catch {%W mark set anchor sel.first}
}
bind Text <Shift-1> {
tkTextResetAnchor %W @%x,%y
@@ -66,7 +69,7 @@ bind Text <Shift-1> {
}
bind Text <Double-Shift-1> {
set tkPriv(selectMode) word
- tkTextSelectTo %W %x %y
+ tkTextSelectTo %W %x %y 1
}
bind Text <Triple-Shift-1> {
set tkPriv(selectMode) line
@@ -201,7 +204,7 @@ bind Text <Return> {
tkTextInsert %W \n
}
bind Text <Delete> {
- if {[%W tag nextrange sel 1.0 end] != ""} {
+ if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
%W delete sel.first sel.last
} else {
%W delete insert
@@ -209,7 +212,7 @@ bind Text <Delete> {
}
}
bind Text <BackSpace> {
- if {[%W tag nextrange sel 1.0 end] != ""} {
+ 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
@@ -271,8 +274,8 @@ bind Text <Meta-KeyPress> {# nothing}
bind Text <Control-KeyPress> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
-if {$tcl_platform(platform) == "macintosh"} {
- bind Text <Command-KeyPress> {# nothing}
+if {[string equal $tcl_platform(platform) "macintosh"]} {
+ bind Text <Command-KeyPress> {# nothing}
}
# Additional emacs-like bindings:
@@ -333,7 +336,7 @@ bind Text <Control-t> {
}
}
-if {$tcl_platform(platform) != "windows"} {
+if {[string compare $tcl_platform(platform) "windows"]} {
bind Text <Control-v> {
if {!$tk_strictMotif} {
tkTextScrollPages %W 1
@@ -380,7 +383,7 @@ bind Text <Meta-Delete> {
# Macintosh only bindings:
# if text black & highlight black -> text white, other text the same
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string equal $tcl_platform(platform) "macintosh"]} {
bind Text <FocusIn> {
%W tag configure sel -borderwidth 0
%W configure -selectbackground systemHighlight -selectforeground systemHighlightText
@@ -447,6 +450,31 @@ bind Text <B2-Motion> {
}
set tkPriv(prevPos) {}
+# The MouseWheel will typically only fire on Windows. However,
+# someone could use the "event generate" command to produce one
+# on other platforms.
+
+bind Text <MouseWheel> {
+ %W yview scroll [expr {- (%D / 120) * 4}] units
+}
+
+if {[string equal "unix" $tcl_platform(platform)]} {
+ # 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
+ }
+ }
+}
+
# tkTextClosestGap --
# Given x and y coordinates, this procedure finds the closest boundary
# between characters to the given coordinates and returns the index
@@ -460,7 +488,7 @@ set tkPriv(prevPos) {}
proc tkTextClosestGap {w x y} {
set pos [$w index @$x,$y]
set bbox [$w bbox $pos]
- if {![string compare $bbox ""]} {
+ if {[string equal $bbox ""]} {
return $pos
}
if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
@@ -487,7 +515,7 @@ proc tkTextButton1 {w x y} {
set tkPriv(pressX) $x
$w mark set insert [tkTextClosestGap $w $x $y]
$w mark set anchor insert
- focus $w
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkTextSelectTo --
@@ -502,7 +530,7 @@ proc tkTextButton1 {w x y} {
# x - Mouse x position.
# y - Mouse y position.
-proc tkTextSelectTo {w x y} {
+proc tkTextSelectTo {w x y {extend 0}} {
global tkPriv tcl_platform
set cur [tkTextClosestGap $w $x $y]
@@ -526,10 +554,18 @@ proc tkTextSelectTo {w x y} {
word {
if {[$w compare $cur < anchor]} {
set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
- set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
+ if { !$extend } {
+ set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
+ } else {
+ set last anchor
+ }
} else {
- set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
+ if { !$extend } {
+ set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
+ } else {
+ set first anchor
+ }
}
}
line {
@@ -542,8 +578,9 @@ proc tkTextSelectTo {w x y} {
}
}
}
- if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {
- if {$tcl_platform(platform) != "unix" && [$w compare $cur < anchor]} {
+ if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
+ if {[string compare $tcl_platform(platform) "unix"] \
+ && [$w compare $cur < anchor]} {
$w mark set insert $first
} else {
$w mark set insert $last
@@ -595,7 +632,7 @@ proc tkTextKeyExtend {w index} {
proc tkTextPaste {w x y} {
$w mark set insert [tkTextClosestGap $w $x $y]
catch {$w insert insert [selection get -displayof $w]}
- if {[$w cget -state] == "normal"} {focus $w}
+ if {[string equal [$w cget -state] "normal"]} {focus $w}
}
# tkTextAutoScan --
@@ -624,7 +661,7 @@ proc tkTextAutoScan {w} {
return
}
tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
- set tkPriv(afterId) [after 50 tkTextAutoScan $w]
+ set tkPriv(afterId) [after 50 [list tkTextAutoScan $w]]
}
# tkTextSetCursor
@@ -661,7 +698,7 @@ proc tkTextSetCursor {w pos} {
proc tkTextKeySelect {w new} {
global tkPriv
- if {[$w tag nextrange sel 1.0 end] == ""} {
+ if {[string equal [$w tag nextrange sel 1.0 end] ""]} {
if {[$w compare $new < insert]} {
$w tag add sel $new insert
} else {
@@ -702,7 +739,7 @@ proc tkTextKeySelect {w new} {
proc tkTextResetAnchor {w index} {
global tkPriv
- if {[$w tag ranges sel] == ""} {
+ if {[string equal [$w tag ranges sel] ""]} {
$w mark set anchor $index
return
}
@@ -749,11 +786,11 @@ proc tkTextResetAnchor {w index} {
# s - The string to insert (usually just a single character)
proc tkTextInsert {w s} {
- if {($s == "") || ([$w cget -state] == "disabled")} {
+ if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
return
}
catch {
- if {[$w compare sel.first <= insert]
+ if {[$w compare sel.first <= insert] \
&& [$w compare sel.last >= insert]} {
$w delete sel.first sel.last
}
@@ -780,7 +817,7 @@ proc tkTextUpDownLine {w n} {
set i [$w index insert]
scan $i "%d.%d" line char
- if {[string compare $tkPriv(prevPos) $i] != 0} {
+ if {[string compare $tkPriv(prevPos) $i]} {
set tkPriv(char) $char
}
set new [$w index [expr {$line + $n}].$tkPriv(char)]
@@ -802,14 +839,15 @@ proc tkTextUpDownLine {w n} {
proc tkTextPrevPara {w pos} {
set pos [$w index "$pos linestart"]
- while 1 {
- if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))
- || ($pos == "1.0")} {
+ 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] || ($pos == "1.0")} {
+ if {[$w compare $pos != insert] || [string equal $pos 1.0]} {
return $pos
}
}
@@ -828,13 +866,13 @@ proc tkTextPrevPara {w pos} {
proc tkTextNextPara {w start} {
set pos [$w index "$start linestart + 1 line"]
- while {[$w get $pos] != "\n"} {
+ 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 {[$w get $pos] == "\n"} {
+ while {[string equal [$w get $pos] "\n"]} {
set pos [$w index "$pos + 1 line"]
if {[$w compare $pos == end]} {
return [$w index "end - 1c"]
@@ -862,7 +900,7 @@ proc tkTextNextPara {w start} {
proc tkTextScrollPages {w count} {
set bbox [$w bbox insert]
$w yview scroll $count pages
- if {$bbox == ""} {
+ if {[string equal $bbox ""]} {
return [$w index @[expr {[winfo height $w]/2}],0]
}
return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
@@ -932,7 +970,7 @@ proc tk_textCut w {
proc tk_textPaste w {
global tcl_platform
catch {
- if {"$tcl_platform(platform)" != "unix"} {
+ if {[string compare $tcl_platform(platform) "unix"]} {
catch {
$w delete sel.first sel.last
}
@@ -951,7 +989,7 @@ proc tk_textPaste w {
# w - The text window in which the cursor is to move.
# start - Position at which to start search.
-if {$tcl_platform(platform) == "windows"} {
+if {[string equal $tcl_platform(platform) "windows"]} {
proc tkTextNextWord {w start} {
tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
tcl_startOfNextWord
@@ -975,9 +1013,15 @@ proc tkTextNextPos {w start op} {
set text ""
set cur $start
while {[$w compare $cur < end]} {
- set text "$text[$w get $cur "$cur lineend + 1c"]"
+ set 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"]
@@ -998,9 +1042,21 @@ proc tkTextPrevPos {w start op} {
set text ""
set cur $start
while {[$w compare $cur > 0.0]} {
- set text "[$w get "$cur linestart - 1c" $cur]$text"
+ set 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"]
@@ -1008,3 +1064,4 @@ proc tkTextPrevPos {w start op} {
return 0.0
}
+
diff --git a/tk/library/textfile.gif b/tk/library/textfile.gif
new file mode 100644
index 00000000000..764d498aa53
--- /dev/null
+++ b/tk/library/textfile.gif
Binary files differ
diff --git a/tk/library/tk.tcl b/tk/library/tk.tcl
index 5d6784a46ae..37335cd23af 100644
--- a/tk/library/tk.tcl
+++ b/tk/library/tk.tcl
@@ -3,32 +3,143 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# SCCS: @(#) tk.tcl 1.98 97/10/28 15:21:04
+# RCS: @(#) $Id$
#
# Copyright (c) 1992-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.
# Insist on running with compatible versions of Tcl and Tk.
-package require -exact Tk 8.0
-package require -exact Tcl 8.0
+package require -exact Tk 8.3
+package require -exact Tcl 8.3
# Add Tk's directory to the end of the auto-load search path, if it
# isn't already on the path:
-if {[info exists auto_path]} {
- if {[lsearch -exact $auto_path $tk_library] < 0} {
- lappend auto_path $tk_library
- }
+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
+# Create a ::tk namespace
+
+namespace eval ::tk {
+}
+
+# ::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]}]
+ }
+ }
+ 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]
+ }
+ 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"
+ foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
+ unset ::tk::FocusGrab($index)
+
+ 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
+ }
+ }
+}
+
# tkScreenChanged --
# This procedure is invoked by the binding mechanism whenever the
# "current" screen is changing. The procedure does two things.
@@ -55,32 +166,30 @@ proc tkScreenChanged screen {
set tkPriv(screen) $screen
return
}
- set tkPriv(activeMenu) {}
- set tkPriv(activeItem) {}
- set tkPriv(afterId) {}
- set tkPriv(buttons) 0
- set tkPriv(buttonWindow) {}
- set tkPriv(dragging) 0
- set tkPriv(focus) {}
- set tkPriv(grab) {}
- set tkPriv(initPos) {}
- set tkPriv(inMenubutton) {}
- set tkPriv(listboxPrev) {}
- set tkPriv(menuBar) {}
- set tkPriv(mouseMoved) 0
- set tkPriv(oldGrab) {}
- set tkPriv(popup) {}
- set tkPriv(postedMb) {}
- set tkPriv(pressX) 0
- set tkPriv(pressY) 0
- set tkPriv(prevPos) 0
- set tkPriv(screen) $screen
- set tkPriv(selectMode) char
- if {[string compare $tcl_platform(platform) "unix"] == 0} {
- set tkPriv(tearoff) 1
- } else {
- set tkPriv(tearoff) 0
+ array set tkPriv {
+ activeMenu {}
+ activeItem {}
+ afterId {}
+ buttons 0
+ buttonWindow {}
+ dragging 0
+ focus {}
+ grab {}
+ initPos {}
+ inMenubutton {}
+ listboxPrev {}
+ menuBar {}
+ mouseMoved 0
+ oldGrab {}
+ popup {}
+ postedMb {}
+ pressX 0
+ pressY 0
+ prevPos 0
+ selectMode char
}
+ set tkPriv(screen) $screen
+ set tkPriv(tearoff) [string equal $tcl_platform(platform) "unix"]
set tkPriv(window) {}
}
@@ -113,6 +222,45 @@ proc tkEventMotifBindings {n1 dummy dummy} {
}
#----------------------------------------------------------------------
+# 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 tkColorDialog $args]
+ }
+}
+if {[string equal [info commands tk_getOpenFile] ""]} {
+ proc tk_getOpenFile {args} {
+ if {$::tk_strictMotif} {
+ return [eval tkMotifFDialog open $args]
+ } else {
+ return [eval ::tk::dialog::file::tkFDialog open $args]
+ }
+ }
+}
+if {[string equal [info commands tk_getSaveFile] ""]} {
+ proc tk_getSaveFile {args} {
+ if {$::tk_strictMotif} {
+ return [eval tkMotifFDialog save $args]
+ } else {
+ return [eval ::tk::dialog::file::tkFDialog save $args]
+ }
+ }
+}
+if {[string equal [info commands tk_messageBox] ""]} {
+ proc tk_messageBox {args} {
+ return [eval tkMessageBox $args]
+ }
+}
+if {[string equal [info command tk_chooseDirectory] ""]} {
+ proc tk_chooseDirectory {args} {
+ return [eval ::tk::dialog::file::chooseDir::tkChooseDirectory $args]
+ }
+}
+
+#----------------------------------------------------------------------
# Define the set of common virtual events.
#----------------------------------------------------------------------
@@ -122,6 +270,19 @@ switch $tcl_platform(platform) {
event add <<Copy>> <Control-Key-c> <Key-F16>
event add <<Paste>> <Control-Key-v> <Key-F18>
event add <<PasteSelection>> <ButtonRelease-2>
+ # 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" { event add <<PrevWindow>> <hpBackTab> }
+ }
+ }
trace variable tk_strictMotif w tkEventMotifBindings
set tk_strictMotif $tk_strictMotif
}
@@ -144,22 +305,24 @@ switch $tcl_platform(platform) {
# Read in files that define all of the class bindings.
# ----------------------------------------------------------------------
-if {$tcl_platform(platform) != "macintosh"} {
- source $tk_library/button.tcl
- source $tk_library/entry.tcl
- source $tk_library/listbox.tcl
- source $tk_library/menu.tcl
- source $tk_library/scale.tcl
- source $tk_library/scrlbar.tcl
- source $tk_library/text.tcl
+if {[string compare $tcl_platform(platform) "macintosh"] && \
+ [string compare {} $tk_library]} {
+ source [file join $tk_library button.tcl]
+ source [file join $tk_library entry.tcl]
+ source [file join $tk_library listbox.tcl]
+ source [file join $tk_library menu.tcl]
+ source [file join $tk_library scale.tcl]
+ source [file join $tk_library scrlbar.tcl]
+ source [file join $tk_library text.tcl]
}
# ----------------------------------------------------------------------
# Default bindings for keyboard traversal.
# ----------------------------------------------------------------------
+event add <<PrevWindow>> <Shift-Tab>
bind all <Tab> {tkTabToWindow [tk_focusNext %W]}
-bind all <Shift-Tab> {tkTabToWindow [tk_focusPrev %W]}
+bind all <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
# tkCancelRepeat --
# This procedure is invoked to cancel an auto-repeat action described
@@ -184,9 +347,11 @@ proc tkCancelRepeat {} {
# w - Window to which focus should be set.
proc tkTabToWindow {w} {
- if {"[winfo class $w]" == "Entry"} {
- $w select range 0 end
- $w icur end
+ if {[string equal [winfo class $w] Entry]} {
+ $w selection range 0 end
+ $w icursor end
}
focus $w
}
+
+
diff --git a/tk/library/tkfbox.tcl b/tk/library/tkfbox.tcl
index e9025418518..a0f48bcbc5a 100644
--- a/tk/library/tkfbox.tcl
+++ b/tk/library/tkfbox.tcl
@@ -11,9 +11,9 @@
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
#
-# SCCS: @(#) tkfbox.tcl 1.13 97/10/01 14:51:01
+# RCS: @(#) $Id$
#
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# 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.
@@ -52,7 +52,6 @@ proc tkIconList_Config {w argList} {
set specs {
{-browsecmd "" "" ""}
{-command "" "" ""}
- {-multiple "" "" "0"}
}
# 2: parse the arguments
@@ -77,8 +76,8 @@ proc tkIconList_Create {w} {
pack $data(sbar) -side bottom -fill x -padx 2
pack $data(canvas) -expand yes -fill both
- $data(sbar) config -command "$data(canvas) xview"
- $data(canvas) config -xscrollcommand "$data(sbar) set"
+ $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
#
@@ -92,26 +91,26 @@ proc tkIconList_Create {w} {
# Creates the event bindings.
#
- bind $data(canvas) <Configure> "tkIconList_Arrange $w"
-
- bind $data(canvas) <1> "tkIconList_Btn1 $w %x %y"
- bind $data(canvas) <B1-Motion> "tkIconList_Motion1 $w %x %y"
- bind $data(canvas) <Shift-1> "tkIconList_ShiftBtn1 $w %x %y"
- bind $data(canvas) <Double-1> "tkIconList_Double1 $w %x %y"
- bind $data(canvas) <ButtonRelease-1> "tkCancelRepeat"
- bind $data(canvas) <B1-Leave> "tkIconList_Leave1 $w %x %y"
- bind $data(canvas) <B1-Enter> "tkCancelRepeat"
-
- bind $data(canvas) <Up> "tkIconList_UpDown $w -1"
- bind $data(canvas) <Down> "tkIconList_UpDown $w 1"
- bind $data(canvas) <Left> "tkIconList_LeftRight $w -1"
- bind $data(canvas) <Right> "tkIconList_LeftRight $w 1"
- bind $data(canvas) <Return> "tkIconList_ReturnKey $w"
- bind $data(canvas) <KeyPress> "tkIconList_KeyPress $w %A"
+ bind $data(canvas) <Configure> [list tkIconList_Arrange $w]
+
+ bind $data(canvas) <1> [list tkIconList_Btn1 $w %x %y]
+ bind $data(canvas) <B1-Motion> [list tkIconList_Motion1 $w %x %y]
+ bind $data(canvas) <B1-Leave> [list tkIconList_Leave1 $w %x %y]
+ bind $data(canvas) <B1-Enter> [list tkCancelRepeat]
+ bind $data(canvas) <ButtonRelease-1> [list tkCancelRepeat]
+ bind $data(canvas) <Double-ButtonRelease-1> \
+ [list tkIconList_Double1 $w %x %y]
+
+ bind $data(canvas) <Up> [list tkIconList_UpDown $w -1]
+ bind $data(canvas) <Down> [list tkIconList_UpDown $w 1]
+ bind $data(canvas) <Left> [list tkIconList_LeftRight $w -1]
+ bind $data(canvas) <Right> [list tkIconList_LeftRight $w 1]
+ bind $data(canvas) <Return> [list tkIconList_ReturnKey $w]
+ bind $data(canvas) <KeyPress> [list tkIconList_KeyPress $w %A]
bind $data(canvas) <Control-KeyPress> ";"
- bind $data(canvas) <Alt-KeyPress> ";"
+ bind $data(canvas) <Alt-KeyPress> ";"
- bind $data(canvas) <FocusIn> "tkIconList_FocusIn $w"
+ bind $data(canvas) <FocusIn> [list tkIconList_FocusIn $w]
return $w
}
@@ -151,7 +150,7 @@ proc tkIconList_AutoScan {w} {
}
tkIconList_Motion1 $w $x $y
- set tkPriv(afterId) [after 50 tkIconList_AutoScan $w]
+ set tkPriv(afterId) [after 50 [list tkIconList_AutoScan $w]]
}
# Deletes all the items inside the canvas subwidget and reset the IconList's
@@ -284,13 +283,13 @@ proc tkIconList_Arrange {w} {
}
if {$sW < $W} {
- $data(canvas) config -scrollregion "$pad $pad $sW $H"
+ $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 "$pad $pad $sW $H"
- $data(sbar) config -command "$data(canvas) xview"
+ $data(canvas) config -scrollregion [list $pad $pad $sW $H]
+ $data(sbar) config -command [list $data(canvas) xview]
set data(noScroll) 0
}
@@ -299,7 +298,7 @@ proc tkIconList_Arrange {w} {
set data(itemsPerColumn) 1
}
- if {$data(curItem) != {}} {
+ if {$data(curItem) != ""} {
tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 0
}
}
@@ -310,8 +309,8 @@ proc tkIconList_Arrange {w} {
proc tkIconList_Invoke {w} {
upvar #0 $w data
- if {[string compare $data(-command) ""] && [info exists data(selected)]} {
- eval $data(-command) [list $data(selected)]
+ if {$data(-command) != "" && [info exists data(selected)]} {
+ uplevel #0 $data(-command)
}
}
@@ -327,7 +326,7 @@ proc tkIconList_See {w rTag} {
return
}
set sRegion [$data(canvas) cget -scrollregion]
- if {![string compare $sRegion {}]} {
+ if {[string equal $sRegion {}]} {
return
}
@@ -372,19 +371,7 @@ proc tkIconList_SelectAtXY {w x y} {
upvar #0 $w data
tkIconList_Select $w [$data(canvas) find closest \
- [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
-}
-
-proc tkIconList_AddSelectAtXY {w x y {no_delete 0}} {
- upvar #0 $w data
-
- if {$data(-multiple) && [info exists data(selected)]} {
- tkIconList_AddSelect $w [$data(canvas) find closest \
- [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] \
- 1 $no_delete
- return
- }
- tkIconList_SelectAtXY $w $x $y
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
}
proc tkIconList_Select {w rTag {callBrowse 1}} {
@@ -399,115 +386,33 @@ proc tkIconList_Select {w rTag {callBrowse 1}} {
set text [lindex $itemList($rTag) 2]
set serial [lindex $itemList($rTag) 3]
- if {$data(-multiple) && [info exists data(rect)]} {
- foreach r $data(rect) {
- $data(canvas) delete $r
- }
- unset data(rect)
- }
- if ![info exists data(rect)] {
-
+ if {![info exists data(rect)]} {
set data(rect) [$data(canvas) create rect 0 0 0 0 \
- -fill #a0a0ff -outline #a0a0ff]
+ -fill #a0a0ff -outline #a0a0ff]
}
$data(canvas) lower $data(rect)
set bbox [$data(canvas) bbox $tTag]
- eval $data(canvas) coords $data(rect) $bbox
+ eval [list $data(canvas) coords $data(rect)] $bbox
set data(curItem) $serial
-
- #we can't set the text to data(selected) as text, this is bugy,
- #when the path contains blanks
- if {$data(-multiple)} {
- catch {unset data(selected)}
- lappend data(selected) $text
- } else {
- set data(selected) $text
- }
-
- if {$callBrowse} {
- if [string compare $data(-browsecmd) ""] {
- eval $data(-browsecmd) [list $data(selected)]
- }
- }
-}
+ set data(selected) $text
-proc tkIconList_AddSelect {w rTag {callBrowse 1} {no_delete 0}} {
- upvar #0 $w data
- upvar #0 $w:itemList itemList
-
- if ![info exists itemList($rTag)] {
- return
- }
- set iTag [lindex $itemList($rTag) 0]
- set tTag [lindex $itemList($rTag) 1]
- set text [lindex $itemList($rTag) 2]
- set serial [lindex $itemList($rTag) 3]
-
- if {[lsearch -exact $data(selected) $text] != -1} {
- if {$no_delete} {
- return
- }
-
- # we've clicked on an existing item, so we need to remove it
- set i [lsearch -exact $data(selected) $text]
- set data(selected) [lreplace $data(selected) $i $i]
-
- # find the appropriate coordinates and remove the
- # corresponding rectangle.
- set tmpbbox [$data(canvas) bbox $tTag]
- for {set i 0} {$i<[llength $data(rect)]} {incr i} {
- set rectTag [lindex $data(rect) $i]
- set testbbox [$data(canvas) coords $rectTag]
- # test first two coordinates; if they're the same the
- # entire box should match
- if {[lindex $testbbox 0]==[lindex $tmpbbox 0] && \
- [lindex $testbbox 1]==[lindex $tmpbbox 1]} {
- $data(canvas) delete $rectTag
- set data(rect) [lreplace $data(rect) $i $i]
- break
- }
- }
-
- if {$callBrowse} {
- if [string compare $data(-browsecmd) ""] {
- eval $data(-browsecmd) [list $data(selected)]
- }
- }
- return
- }
-
- set tmprect [$data(canvas) create rect 0 0 0 0 \
- -fill #a0a0ff -outline #a0a0ff]
- lappend data(rect) $tmprect
-
- $data(canvas) lower $tmprect
- set bbox [$data(canvas) bbox $tTag]
- eval $data(canvas) coords $tmprect $bbox
-
- set data(curItem) $serial
- lappend data(selected) $text
-
- if {$callBrowse} {
- if [string compare $data(-browsecmd) ""] {
- eval $data(-browsecmd) [list $data(selected)]
- }
+ if {$callBrowse && $data(-browsecmd) != ""} {
+ eval $data(-browsecmd) [list $text]
}
}
proc tkIconList_Unselect {w} {
upvar #0 $w data
- if [info exists data(rect)] {
- foreach r $data(rect) {
- $data(canvas) delete $r
- }
+ if {[info exists data(rect)]} {
+ $data(canvas) delete $data(rect)
unset data(rect)
}
if {[info exists data(selected)]} {
unset data(selected)
}
- set data(curItem) {}
+ #set data(curItem) {}
}
# Returns the selected item
@@ -530,13 +435,6 @@ proc tkIconList_Btn1 {w x y} {
tkIconList_SelectAtXY $w $x $y
}
-proc tkIconList_ShiftBtn1 {w x y} {
- upvar #0 $w data
-
- focus $data(canvas)
- tkIconList_AddSelectAtXY $w $x $y
-}
-
# Gets called on button-1 motions
#
proc tkIconList_Motion1 {w x y} {
@@ -544,13 +442,13 @@ proc tkIconList_Motion1 {w x y} {
set tkPriv(x) $x
set tkPriv(y) $y
- tkIconList_AddSelectAtXY $w $x $y 1
+ tkIconList_SelectAtXY $w $x $y
}
proc tkIconList_Double1 {w x y} {
upvar #0 $w data
- if {$data(curItem) != {}} {
+ if {[string compare $data(curItem) {}]} {
tkIconList_Invoke $w
}
}
@@ -574,9 +472,8 @@ proc tkIconList_FocusIn {w} {
return
}
- if {$data(curItem) == {}} {
- set rTag [lindex [lindex $data(list) 0] 2]
- tkIconList_Select $w $rTag
+ if {[string compare $data(curItem) {}]} {
+ tkIconList_Select $w [lindex [lindex $data(list) $data(curItem)] 2] 1
}
}
@@ -595,12 +492,12 @@ proc tkIconList_UpDown {w amount} {
return
}
- if {$data(curItem) == {}} {
+ if {[string equal $data(curItem) {}]} {
set rTag [lindex [lindex $data(list) 0] 2]
} else {
set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
set rTag [lindex [lindex $data(list) [expr {$data(curItem)+$amount}]] 2]
- if {![string compare $rTag ""]} {
+ if {[string equal $rTag ""]} {
set rTag $oldRTag
}
}
@@ -625,13 +522,13 @@ proc tkIconList_LeftRight {w amount} {
if {![info exists data(list)]} {
return
}
- if {$data(curItem) == {}} {
+ if {[string equal $data(curItem) {}]} {
set rTag [lindex [lindex $data(list) 0] 2]
} else {
set oldRTag [lindex [lindex $data(list) $data(curItem)] 2]
set newItem [expr {$data(curItem)+($amount*$data(itemsPerColumn))}]
set rTag [lindex [lindex $data(list) $newItem] 2]
- if {![string compare $rTag ""]} {
+ if {[string equal $rTag ""]} {
set rTag $oldRTag
}
}
@@ -658,7 +555,7 @@ proc tkIconList_KeyPress {w key} {
catch {
after cancel $tkPriv(ILAccel,$w,afterId)
}
- set tkPriv(ILAccel,$w,afterId) [after 500 tkIconList_Reset $w]
+ set tkPriv(ILAccel,$w,afterId) [after 500 [list tkIconList_Reset $w]]
}
proc tkIconList_Goto {w text} {
@@ -670,11 +567,11 @@ proc tkIconList_Goto {w text} {
return
}
- if {[string length $text] == 0} {
+ if {[string equal {} $text]} {
return
}
- if {$data(curItem) == {} || $data(curItem) == 0} {
+ if {$data(curItem) == "" || $data(curItem) == 0} {
set start 0
} else {
set start $data(curItem)
@@ -689,9 +586,9 @@ proc tkIconList_Goto {w text} {
# Search forward until we find a filename whose prefix is an exact match
# with $text
- while 1 {
+ while {1} {
set sub [string range $textList($i) 0 $len0]
- if {[string compare $text $sub] == 0} {
+ if {[string equal $text $sub]} {
set theIndex $i
break
}
@@ -706,7 +603,7 @@ proc tkIconList_Goto {w text} {
if {$theIndex > -1} {
set rTag [lindex [lindex $data(list) $theIndex] 2]
- tkIconList_Select $w $rTag 0
+ tkIconList_Select $w $rTag
tkIconList_See $w $rTag
}
}
@@ -723,54 +620,40 @@ proc tkIconList_Reset {w} {
#
#----------------------------------------------------------------------
-# tkFDialog --
+namespace eval ::tk::dialog {}
+namespace eval ::tk::dialog::file {}
+
+# ::tk::dialog::file::tkFDialog --
#
# Implements the TK file selection dialog. This dialog is used when
# the tk_strictMotif flag is set to false. This procedure shouldn't
# be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
#
-proc tkFDialog {args} {
- global tkPriv
- global __old_dialog
- global __old_multiple
- set w __tk_filedialog
- upvar #0 $w data
+# Arguments:
+# type "open" or "save"
+# args Options parsed by the procedure.
+#
- if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
- set type open
- } else {
- set type save
- }
+proc ::tk::dialog::file::tkFDialog {type args} {
+ global tkPriv
+ set dataName __tk_filedialog
+ upvar ::tk::dialog::file::$dataName data
- tkFDialog_Config $w $type $args
+ ::tk::dialog::file::Config $dataName $type $args
- if {![string compare $data(-parent) .]} {
- set w .$w
+ if {[string equal $data(-parent) .]} {
+ set w .$dataName
} else {
- set w $data(-parent).$w
+ set w $data(-parent).$dataName
}
- #because tk doesn't use window-path dependent array, it is
- #impossible to use more than one dialog box at the same time,
- #so we have to recreate the dialog!
- if {[info exists __old_dialog] \
- && ($__old_dialog != $w || $__old_multiple != $data(-multiple))} {
- catch {destroy $w}
- catch {destroy $__old_dialog}
- }
- set __old_dialog $w
- set __old_multiple $data(-multiple)
-
# (re)create the dialog box if necessary
#
- set new_dialog 0
if {![winfo exists $w]} {
- tkFDialog_Create $w
- set new_dialog 1
+ ::tk::dialog::file::Create $w TkFDialog
} elseif {[string compare [winfo class $w] TkFDialog]} {
destroy $w
- tkFDialog_Create $w
- set new_dialog 1
+ ::tk::dialog::file::Create $w TkFDialog
} else {
set data(dirMenuBtn) $w.f1.menu
set data(dirMenu) $w.f1.menu.menu
@@ -784,20 +667,25 @@ proc tkFDialog {args} {
set data(cancelBtn) $w.f3.cancel
}
wm transient $w $data(-parent)
- #trace variable
- trace variable data(selectPath) w "tkFDialog_SetPath $w"
- # 5. Initialize the file types menu
+ # 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 {$data(-filetypes) != {}} {
+ 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 tkFDialog_SetFilter $w $type]
+ -command [list ::tk::dialog::file::SetFilter $w $type]
}
- tkFDialog_SetFilter $w [lindex $data(-filetypes) 0]
+ ::tk::dialog::file::SetFilter $w [lindex $data(-filetypes) 0]
$data(typeMenuBtn) config -state normal
$data(typeMenuLab) config -state normal
} else {
@@ -805,73 +693,61 @@ proc tkFDialog {args} {
$data(typeMenuBtn) config -state disabled -takefocus 0
$data(typeMenuLab) config -state disabled
}
+ ::tk::dialog::file::UpdateWhenIdle $w
- tkFDialog_UpdateWhenIdle $w
-
- # 6. Withdraw the window, then update all the geometry information
+ # Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display and de-iconify it.
- if {$new_dialog} {
- #center dialog, when it has been new created
- wm withdraw $w
- update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
- }
+ ::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
- wm deiconify $w
- # 7. Set a grab and claim the focus too.
+ # Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {$oldGrab != ""} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- focus $data(ent)
+ ::tk::SetFocusGrab $w $data(ent)
$data(ent) delete 0 end
$data(ent) insert 0 $data(selectFile)
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
- # 8. Wait for the user to respond, then restore the focus and
+ # Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
# before deleting the window, since otherwise the window manager
# may take the focus away so we can't redirect it. Finally,
# restore any grab that was in effect.
tkwait variable tkPriv(selectFilePath)
- catch {focus $oldFocus}
- grab release $w
- wm withdraw $w
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
+
+ ::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]
}
- #delete the tracer, because this conflicts with multiple
- #used dialogs
- trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ $data(dirMenuBtn) configure -textvariable {}
+
return $tkPriv(selectFilePath)
}
-# tkFDialog_Config --
+# ::tk::dialog::file::Config --
#
# Configures the TK filedialog according to the argument list
#
-proc tkFDialog_Config {w type argList} {
- upvar #0 $w data
+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 {
@@ -882,15 +758,6 @@ proc tkFDialog_Config {w type argList} {
{-parent "" "" "."}
{-title "" "" ""}
}
- if ![string compare $type open] {
- # CYGNUS LOCAL: Handle -choosedir.
- # Note: the -choosedir option is a Cygnus extension. It is not
- # documented since it only works on Unix -- it is an
- # implementation detail of the directory-choosing code in
- # in libgui.
- lappend specs {-multiple "" "" "0"} {-choosedir "" "" "0"}
- # END CYGNUS LOCAL
- }
# 2: default values depending on the type of the dialog
#
@@ -902,10 +769,10 @@ proc tkFDialog_Config {w type argList} {
# 3: parse the arguments
#
- tclParseConfigSpec $w $specs "" $argList
+ tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
- if {![string compare $data(-title) ""]} {
- if {![string compare $type "open"]} {
+ if {$data(-title) == ""} {
+ if {[string equal $type "open"]} {
set data(-title) "Open"
} else {
set data(-title) "Save As"
@@ -915,24 +782,16 @@ proc tkFDialog_Config {w type argList} {
# 4: set the default directory and selection according to the -initial
# settings
#
- # Khamis 16-04-98
- # When the path contains blanks, glob returns an item in a list, but
- # data(selectPath) must be an item and not a list of items, so we
- # must extract the item from the returned list.
- if {[string compare $data(-initialdir) ""]} {
- if {[file isdirectory $data(-initialdir)]} {
- #khamis: Join result of glob to an item
- set data(selectPath) [lindex [glob $data(-initialdir)] 0]
+ 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]
}
-
- # 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)
@@ -943,35 +802,21 @@ proc tkFDialog_Config {w type argList} {
if {![winfo exists $data(-parent)]} {
error "bad window path name \"$data(-parent)\""
}
-
- # Set -multiple to a one or zero value (not other boolean types
- # like "yes") so we can use it in tests easier.
- if {![string compare $type save]} {
- set data(-multiple) 0
- # CYGNUS LOCAL: choosedir
- # Handle -choosedir here as well.
- set data(-choosedir) 0
- # END CYGNUS LOCAL
- } else {
- if {$data(-multiple)} {
- set data(-multiple) 1
- }
- }
}
-proc tkFDialog_Create {w} {
+proc ::tk::dialog::file::Create {w class} {
set dataName [lindex [split $w .] end]
- upvar #0 $dataName data
- global tk_library
+ upvar ::tk::dialog::file::$dataName data
+ global tk_library tkPriv
- toplevel $w -class TkFDialog
+ toplevel $w -class $class
# f1: the frame with the directory option menu
#
set f1 [frame $w.f1]
label $f1.lab -text "Directory:" -under 0
set data(dirMenuBtn) $f1.menu
- set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) $dataName] ""]
+ set data(dirMenu) [tk_optionMenu $f1.menu [format %s(selectPath) ::tk::dialog::file::$dataName] ""]
set data(upBtn) [button $f1.up]
if {![info exists tkPriv(updirImage)]} {
set tkPriv(updirImage) [image create bitmap -data {
@@ -995,18 +840,24 @@ static char updir_bits[] = {
# data(icons): the IconList that list the files and directories.
#
+ if { [string equal $class TkFDialog] } {
+ set fNameCaption "File name:"
+ set fNameUnder 5
+ set iconListCommand [list ::tk::dialog::file::OkCmd $w]
+ } else {
+ set fNameCaption "Selection:"
+ set fNameUnder 0
+ set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
+ }
set data(icons) [tkIconList $w.icons \
- -browsecmd "tkFDialog_ListBrowse $w" \
- -command "tkFDialog_ListInvoke $w" \
- -multiple "$data(-multiple)"]
+ -browsecmd [list ::tk::dialog::file::ListBrowse $w] \
+ -command $iconListCommand]
# f2: the frame with the OK button and the "file name" field
#
set f2 [frame $w.f2 -bd 0]
- label $f2.lab -text "File name:" -anchor e -width 14 -under 5 -pady 0
- if {$data(-multiple)} {
- $f2.lab config -text "File names:"
- }
+ label $f2.lab -text $fNameCaption -anchor e -width 14 \
+ -under $fNameUnder -pady 0
set data(ent) [entry $f2.ent]
# The font to use for the icons. The default Canvas font on Unix
@@ -1018,26 +869,30 @@ static char updir_bits[] = {
#
set f3 [frame $w.f3 -bd 0]
- # The "File of types:" label needs to be grayed-out when
- # -filetypes are not specified. The label widget does not support
- # grayed-out text on monochrome displays. Therefore, we have to
- # use a button widget to emulate a label widget (by setting its
- # bindtags)
-
- set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
- -anchor e -width 14 -under 9 \
- -bd [$f2.lab cget -bd] \
- -highlightthickness [$f2.lab cget -highlightthickness] \
- -relief [$f2.lab cget -relief] \
- -padx [$f2.lab cget -padx] \
- -pady [$f2.lab cget -pady]]
- bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
- [winfo toplevel $data(typeMenuLab)] all]
-
- set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 -menu $f3.menu.m]
- set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
- $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
- -relief raised -bd 2 -anchor w
+ # 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) [button $f3.lab -text "Files of type:" \
+ -anchor e -width 14 -under 9 \
+ -bd [$f2.lab cget -bd] \
+ -highlightthickness [$f2.lab cget -highlightthickness] \
+ -relief [$f2.lab cget -relief] \
+ -padx [$f2.lab cget -padx] \
+ -pady [$f2.lab cget -pady]]
+ bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
+ [winfo toplevel $data(typeMenuLab)] all]
+
+ set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 \
+ -menu $f3.menu.m]
+ set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
+ $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
+ -relief raised -bd 2 -anchor w
+ }
# the okBtn is created after the typeMenu so that the keyboard traversal
# is in the right order
@@ -1053,8 +908,10 @@ static char updir_bits[] = {
pack $f2.ent -expand yes -fill x -padx 2 -pady 0
pack $data(cancelBtn) -side right -padx 4 -anchor w
- pack $data(typeMenuLab) -side left -padx 4
- pack $data(typeMenuBtn) -expand yes -fill x -side right
+ 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.
#
@@ -1063,70 +920,83 @@ static char updir_bits[] = {
pack $f2 -side bottom -fill x
pack $data(icons) -expand yes -fill both -padx 4 -pady 1
- # Set up the event handlers
+ # Set up the event handlers that are common to Directory and File Dialogs
#
- bind $data(ent) <Return> "tkFDialog_ActivateEnt $w"
-
- $data(upBtn) config -command "tkFDialog_UpDirCmd $w"
- $data(okBtn) config -command "tkFDialog_OkCmd $w"
- $data(cancelBtn) config -command "tkFDialog_CancelCmd $w"
- #trace variable data(selectPath) w "tkFDialog_SetPath $w"
+ 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 tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-c> [list tkButtonInvoke $data(cancelBtn)]
+ bind $w <Alt-d> [list focus $data(dirMenuBtn)]
- bind $w <Alt-d> "focus $data(dirMenuBtn)"
- bind $w <Alt-t> [format {
- if {"[%s cget -state]" == "normal"} {
- focus %s
- }
- } $data(typeMenuBtn) $data(typeMenuBtn)]
- bind $w <Alt-n> "focus $data(ent)"
- bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
- bind $w <Alt-o> "tkFDialog_InvokeBtn $w Open"
- bind $w <Alt-s> "tkFDialog_InvokeBtn $w Save"
+ # Set up event handlers specific to File or Directory Dialogs
+ #
- wm protocol $w WM_DELETE_WINDOW "tkFDialog_CancelCmd $w"
+ 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)]
+ bind $w <Alt-n> [list focus $data(ent)]
+ bind $w <Alt-o> [list ::tk::dialog::file::InvokeBtn $w Open]
+ bind $w <Alt-s> [list ::tk::dialog::file::InvokeBtn $w Save]
+ } 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 tkButtonInvoke $data(okBtn)]
+ }
# Build the focus group for all the entries
#
tkFocusGroup_Create $w
- tkFocusGroup_BindIn $w $data(ent) "tkFDialog_EntFocusIn $w"
- tkFocusGroup_BindOut $w $data(ent) "tkFDialog_EntFocusOut $w"
+ tkFocusGroup_BindIn $w $data(ent) [list ::tk::dialog::file::EntFocusIn $w]
+ tkFocusGroup_BindOut $w $data(ent) [list ::tk::dialog::file::EntFocusOut $w]
}
-# tkFDialog_UpdateWhenIdle --
+# ::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 tkFDialog_UpdateWhenIdle {w} {
- upvar #0 [winfo name $w] data
+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 tkFDialog_Update $w]
+ set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
}
}
-# tkFDialog_Update --
+# ::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 tkFDialog_Update {w} {
+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] || [string compare [winfo class $w] TkFDialog]} {
+ 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 #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
global tk_library tkPriv
catch {unset data(updateId)}
@@ -1146,10 +1016,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
cd $data(selectPath)
}]} {
# We cannot change directory to $data(selectPath). $data(selectPath)
- # should have been checked before tkFDialog_Update is called, so
+ # 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 $data(-parent) -message \
+ tk_messageBox -type ok -parent $w -message \
"Cannot change to the directory \"$data(selectPath)\".\nPermission denied."\
-icon warning
cd $appPWD
@@ -1170,10 +1040,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
# Make the dir list
#
foreach f [lsort -dictionary [glob -nocomplain .* *]] {
- if {![string compare $f .]} {
+ if {[string equal $f .]} {
continue
}
- if {![string compare $f ..]} {
+ if {[string equal $f ..]} {
continue
}
if {[file isdir ./$f]} {
@@ -1183,22 +1053,23 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
}
}
- # Make the file list
- #
- if {![string compare $data(filter) *]} {
- set files [lsort -dictionary \
- [glob -nocomplain .* *]]
- } else {
- set files [lsort -dictionary \
- [eval glob -nocomplain $data(filter)]]
- }
-
- set top 0
- foreach f $files {
- if {![file isdir ./$f]} {
- if {![info exists hasDoneFile($f)]} {
- tkIconList_Add $data(icons) $file $f
- set hasDoneFile($f) 1
+ if { [string equal $class TkFDialog] } {
+ # Make the file list if this is a File Dialog
+ #
+ if {[string equal $data(filter) *]} {
+ set files [lsort -dictionary \
+ [glob -nocomplain .* *]]
+ } else {
+ set files [lsort -dictionary \
+ [eval glob -nocomplain $data(filter)]]
+ }
+
+ foreach f $files {
+ if {![file isdir ./$f]} {
+ if {![info exists hasDoneFile($f)]} {
+ tkIconList_Add $data(icons) $file $f
+ set hasDoneFile($f) 1
+ }
}
}
}
@@ -1215,7 +1086,7 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
}
$data(dirMenu) delete 0 end
- set var [format %s(selectPath) $dataName]
+ set var [format %s(selectPath) ::tk::dialog::file::$dataName]
foreach path $list {
$data(dirMenu) add command -label $path -command [list set $var $path]
}
@@ -1224,38 +1095,53 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
#
cd $appPWD
+ if { [string equal $class TkFDialog] } {
+ # Restore the Open/Save Button if this is a File Dialog
+ #
+ if {[string equal $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
+ }
+
# turn off the busy cursor.
#
$data(ent) config -cursor $entCursor
$w config -cursor $dlgCursor
}
-# tkFDialog_SetPathSilently --
+# ::tk::dialog::file::SetPathSilently --
#
# Sets data(selectPath) without invoking the trace procedure
#
-proc tkFDialog_SetPathSilently {w path} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::SetPathSilently {w path} {
+ upvar ::tk::dialog::file::[winfo name $w] data
- trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ trace vdelete data(selectPath) w [list ::tk::dialog::file::SetPath $w]
set data(selectPath) $path
- trace variable data(selectPath) w "tkFDialog_SetPath $w"
+ trace variable data(selectPath) w [list ::tk::dialog::file::SetPath $w]
}
# This proc gets called whenever data(selectPath) is set
#
-proc tkFDialog_SetPath {w name1 name2 op} {
+proc ::tk::dialog::file::SetPath {w name1 name2 op} {
if {[winfo exists $w]} {
- upvar #0 [winfo name $w] data
- tkFDialog_UpdateWhenIdle $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 tkFDialog_SetFilter {w type} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::SetFilter {w type} {
+ upvar ::tk::dialog::file::[winfo name $w] data
upvar \#0 $data(icons) icons
set data(filter) [lindex $type 1]
@@ -1263,10 +1149,10 @@ proc tkFDialog_SetFilter {w type} {
$icons(sbar) set 0.0 0.0
- tkFDialog_UpdateWhenIdle $w
+ ::tk::dialog::file::UpdateWhenIdle $w
}
-# tkFDialogResolveFile --
+# tk::dialog::file::ResolveFile --
#
# Interpret the user's text input in a file selection dialog.
# Performs:
@@ -1298,13 +1184,16 @@ proc tkFDialog_SetFilter {w type} {
# directory may not be the same as context, because text may contain
# a subdirectory name
#
-proc tkFDialogResolveFile {context text defaultext} {
+proc ::tk::dialog::file::ResolveFile {context text defaultext} {
set appPWD [pwd]
- set path [tkFDialog_JoinFile $context $text]
+ set path [::tk::dialog::file::JoinFile $context $text]
- if {[file ext $path] == ""} {
+ # 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"
}
@@ -1320,9 +1209,7 @@ proc tkFDialogResolveFile {context text defaultext} {
if {[file exists $path]} {
if {[file isdirectory $path]} {
- if {[catch {
- cd $path
- }]} {
+ if {[catch {cd $path}]} {
return [list CHDIR $path ""]
}
set directory [pwd]
@@ -1330,9 +1217,7 @@ proc tkFDialogResolveFile {context text defaultext} {
set flag OK
cd $appPWD
} else {
- if {[catch {
- cd [file dirname $path]
- }]} {
+ if {[catch {cd [file dirname $path]}]} {
return [list CHDIR [file dirname $path] ""]
}
set directory [pwd]
@@ -1343,9 +1228,7 @@ proc tkFDialogResolveFile {context text defaultext} {
} else {
set dirname [file dirname $path]
if {[file exists $dirname]} {
- if {[catch {
- cd $dirname
- }]} {
+ if {[catch {cd $dirname}]} {
return [list CHDIR $dirname ""]
}
set directory [pwd]
@@ -1371,12 +1254,11 @@ proc tkFDialogResolveFile {context text defaultext} {
# from the icon list . This way the user can be certain that the input in the
# entry box is the selection.
#
-proc tkFDialog_EntFocusIn {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::EntFocusIn {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
if {[string compare [$data(ent) get] ""]} {
- $data(ent) selection from 0
- $data(ent) selection to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
} else {
$data(ent) selection clear
@@ -1384,55 +1266,45 @@ proc tkFDialog_EntFocusIn {w} {
tkIconList_Unselect $data(icons)
- if {![string compare $data(type) open]} {
- $data(okBtn) config -text "Open"
- } else {
- $data(okBtn) config -text "Save"
+ 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]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
}
}
-proc tkFDialog_EntFocusOut {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::EntFocusOut {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
$data(ent) selection clear
}
-# Verification procedure
-proc tkFDialog_VerifyFileName { w fname } {
- upvar #0 [winfo name $w] data
+# 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 list [tkFDialogResolveFile $data(selectPath) $fname \
+ set text [string trim [$data(ent) get]]
+ set list [::tk::dialog::file::ResolveFile $data(selectPath) $text \
$data(-defaultextension)]
set flag [lindex $list 0]
set path [lindex $list 1]
set file [lindex $list 2]
- case $flag {
+ switch -- $flag {
OK {
- if {![string compare $file ""]} {
- tkFDialog_SetPathSilently $w [file dirname $path]
- # CYGNUS LOCAL: handle choosedir
- if {$data(-choosedir)} {
- if {$data(-multiple)} {
- lappend data(selectFile) [file tail $path]
- } else {
- set data(selectFile) [file tail $path]
- }
- tkFDialog_Done $w
- } else {
- # user has entered an existing (sub)directory
- set data(selectPath) $path
- $data(ent) delete 0 end
- }
+ if {[string equal $file ""]} {
+ # user has entered an existing (sub)directory
+ set data(selectPath) $path
+ $data(ent) delete 0 end
} else {
- tkFDialog_SetPathSilently $w $path
- if {$data(-multiple)} {
- lappend data(selectFile) $file
- } else {
- set data(selectFile) $file
- }
- tkFDialog_Done $w
+ ::tk::dialog::file::SetPathSilently $w $path
+ set data(selectFile) $file
+ ::tk::dialog::file::Done $w
}
}
PATTERN {
@@ -1440,79 +1312,54 @@ proc tkFDialog_VerifyFileName { w fname } {
set data(filter) $file
}
FILE {
- if {![string compare $data(type) open]} {
- tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ if {[string equal $data(type) open]} {
+ tk_messageBox -icon warning -type ok -parent $w \
-message "File \"[file join $path $file]\" does not exist."
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
} else {
- tkFDialog_SetPathSilently $w $path
- if {$data(-multiple)} {
- lappend data(selectFile) $file
- } else {
- set data(selectFile) $file
- }
- tkFDialog_Done $w
+ ::tk::dialog::file::SetPathSilently $w $path
+ set data(selectFile) $file
+ ::tk::dialog::file::Done $w
}
}
PATH {
- tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ tk_messageBox -icon warning -type ok -parent $w \
-message "Directory \"$path\" does not exist."
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
}
CHDIR {
- tk_messageBox -type ok -parent $data(-parent) -message \
+ tk_messageBox -type ok -parent $w -message \
"Cannot change to the directory \"$path\".\nPermission denied."\
-icon warning
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
}
ERROR {
- tk_messageBox -type ok -parent $data(-parent) -message \
+ tk_messageBox -type ok -parent $w -message \
"Invalid file name \"$path\"."\
-icon warning
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
}
}
}
-# Gets called when user presses Return in the "File name" entry.
-#
-proc tkFDialog_ActivateEnt {w} {
- upvar #0 [winfo name $w] data
-
- #set text [string trim [$data(ent) get]]
- set text [$data(ent) get]
- if {$data(-multiple)} {
- set data(selectFile) ""
- foreach fname $text {
- tkFDialog_VerifyFileName $w $fname
- }
- } else {
- tkFDialog_VerifyFileName $w $text
- }
-}
-
# Gets called when user presses the Alt-s or Alt-o keys.
#
-proc tkFDialog_InvokeBtn {w key} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::InvokeBtn {w key} {
+ upvar ::tk::dialog::file::[winfo name $w] data
- if {![string compare [$data(okBtn) cget -text] $key]} {
+ if {[string equal [$data(okBtn) cget -text] $key]} {
tkButtonInvoke $data(okBtn)
}
}
# Gets called when user presses the "parent directory" button
#
-proc tkFDialog_UpDirCmd {w} {
- upvar #0 [winfo name $w] data
+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)]
@@ -1522,7 +1369,7 @@ proc tkFDialog_UpDirCmd {w} {
# Join a file name to a path name. The "file join" command will break
# if the filename begins with ~
#
-proc tkFDialog_JoinFile {path file} {
+proc ::tk::dialog::file::JoinFile {path file} {
if {[string match {~*} $file] && [file exists $path/$file]} {
return [file join $path ./$file]
} else {
@@ -1534,28 +1381,25 @@ proc tkFDialog_JoinFile {path file} {
# Gets called when user presses the "OK" button
#
-proc tkFDialog_OkCmd {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::OkCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
set text [tkIconList_Get $data(icons)]
if {[string compare $text ""]} {
- if {!$data(-multiple)} {
- set file [tkFDialog_JoinFile $data(selectPath) $text]
- # CYGNUS LOCAL: handle choosedir
- if {!$data(-choosedir) && [file isdirectory $file]} {
- tkFDialog_ListInvoke $w $text
- return
- }
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
+ if {[file isdirectory $file]} {
+ ::tk::dialog::file::ListInvoke $w $text
+ return
}
}
- tkFDialog_ActivateEnt $w
+ ::tk::dialog::file::ActivateEnt $w
}
# Gets called when user presses the "Cancel" button
#
-proc tkFDialog_CancelCmd {w} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::CancelCmd {w} {
+ upvar ::tk::dialog::file::[winfo name $w] data
global tkPriv
set tkPriv(selectFilePath) ""
@@ -1564,49 +1408,48 @@ proc tkFDialog_CancelCmd {w} {
# Gets called when user browses the IconList widget (dragging mouse, arrow
# keys, etc)
#
-proc tkFDialog_ListBrowse {w text} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::ListBrowse {w text} {
+ upvar ::tk::dialog::file::[winfo name $w] data
- if {$text == ""} {
+ if {[string equal $text ""]} {
return
}
- set file [tkFDialog_JoinFile $data(selectPath) $text]
- # CYGNUS LOCAL: handle choosedir
- if {$data(-choosedir) || ![file isdirectory $file]} {
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
+ if {![file isdirectory $file]} {
$data(ent) delete 0 end
$data(ent) insert 0 $text
- if {![string compare $data(type) open]} {
- $data(okBtn) config -text "Open"
- } else {
- $data(okBtn) config -text "Save"
+ if { [string equal [winfo class $w] TkFDialog] } {
+ if {[string equal $data(type) open]} {
+ $data(okBtn) config -text "Open"
+ } else {
+ $data(okBtn) config -text "Save"
+ }
}
} else {
- $data(okBtn) config -text "Open"
+ if { [string equal [winfo class $w] TkFDialog] } {
+ $data(okBtn) config -text "Open"
+ }
}
}
# Gets called when user invokes the IconList widget (double-click,
# Return key, etc)
#
-proc tkFDialog_ListInvoke {w text} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::ListInvoke {w text} {
+ upvar ::tk::dialog::file::[winfo name $w] data
- if {$text == ""} {
+ if {[string equal $text ""]} {
return
}
- if {$data(-multiple)} {
- set file [tkFDialog_JoinFile $data(selectPath) [lindex $text 0]]
- } else {
- set file [tkFDialog_JoinFile $data(selectPath) $text]
- }
-
- if {[file isdirectory $file]} {
+ set file [::tk::dialog::file::JoinFile $data(selectPath) $text]
+ 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 $data(-parent) -message \
+ tk_messageBox -type ok -parent $w -message \
"Cannot change to the directory \"$file\".\nPermission denied."\
-icon warning
} else {
@@ -1614,16 +1457,12 @@ proc tkFDialog_ListInvoke {w text} {
set data(selectPath) $file
}
} else {
- if {$data(-multiple)} {
- set data(selectFile) [list $file]
- } else {
- set data(selectFile) $file
- }
- tkFDialog_Done $w
+ set data(selectFile) $file
+ ::tk::dialog::file::Done $w
}
}
-# tkFDialog_Done --
+# ::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
@@ -1631,33 +1470,24 @@ proc tkFDialog_ListInvoke {w text} {
# loop in tkFDialog and return the selected filename to the
# script that calls tk_getOpenFile or tk_getSaveFile
#
-proc tkFDialog_Done {w {selectFilePath ""}} {
- upvar #0 [winfo name $w] data
+proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
+ upvar ::tk::dialog::file::[winfo name $w] data
global tkPriv
- if {![string compare $selectFilePath ""]} {
- if {$data(-multiple)} {
- set selectFilePath {}
- foreach f $data(selectFile) {
- lappend selectFilePath [file join $data(selectPath) $f]
- }
- } else {
- set selectFilePath [tkFDialog_JoinFile $data(selectPath) \
- $data(selectFile)]
- }
+ if {[string equal $selectFilePath ""]} {
+ set selectFilePath [::tk::dialog::file::JoinFile $data(selectPath) \
+ $data(selectFile)]
set tkPriv(selectFile) $data(selectFile)
set tkPriv(selectPath) $data(selectPath)
- if {[file exists $selectFilePath] &&
- ![string compare $data(type) save]} {
-
- set reply [tk_messageBox -icon warning -type yesno\
- -parent $data(-parent) -message "File\
- \"$selectFilePath\" already exists.\nDo\
- you want to overwrite it?"]
- if {![string compare $reply "no"]} {
- return
- }
+ if {[file exists $selectFilePath] && [string equal $data(type) save]} {
+ set reply [tk_messageBox -icon warning -type yesno\
+ -parent $w -message "File\
+ \"$selectFilePath\" already exists.\nDo\
+ you want to overwrite it?"]
+ if {[string equal $reply "no"]} {
+ return
+ }
}
}
set tkPriv(selectFilePath) $selectFilePath
diff --git a/tk/library/updir.xbm b/tk/library/updir.xbm
new file mode 100644
index 00000000000..a2404f7c189
--- /dev/null
+++ b/tk/library/updir.xbm
@@ -0,0 +1,9 @@
+#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};
diff --git a/tk/library/xmfbox.tcl b/tk/library/xmfbox.tcl
index e4d4aeeb6ef..67ec66782df 100644
--- a/tk/library/xmfbox.tcl
+++ b/tk/library/xmfbox.tcl
@@ -4,13 +4,16 @@
# Unix platform. This implementation is used only if the
# "tk_strictMotif" flag is set.
#
-# SCCS: @(#) xmfbox.tcl 1.6 97/10/01 15:06:07
+# 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 {}
# tkMotifFDialog --
@@ -18,39 +21,78 @@
# Implements a file dialog similar to the standard Motif file
# selection box.
#
-# Return value:
+# Arguments:
+# type "open" or "save"
+# args Options parsed by the procedure.
#
+# Results:
# A list of two members. The first member is the absolute
# pathname of the selected file or "" if user hits cancel. The
# second member is the name of the selected file type, or ""
# which stands for "default file type"
-#
-proc tkMotifFDialog {args} {
+
+proc tkMotifFDialog {type args} {
global tkPriv
- set w __tk_filedialog
- upvar #0 $w data
+ set dataName __tk_filedialog
+ upvar ::tk::dialog::file::$dataName data
- if {![string compare [lindex [info level 0] 0] tk_getOpenFile]} {
- set type open
- } else {
- set type save
- }
+ set w [tkMotifFDialog_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.
+
+ tkwait variable tkPriv(selectFilePath)
+ ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
+
+ return $tkPriv(selectFilePath)
+}
+
+# tkMotifFDialog_Create --
+#
+# Creates the Motif file dialog (if it doesn't exist yet) and
+# initialize the internal data structure associated with the
+# dialog.
+#
+# This procedure is used by tkMotifFDialog to create the
+# dialog. It's also used by the test suite to test the Motif
+# file dialog implementation. User code shouldn't call this
+# procedure directly.
+#
+# Arguments:
+# dataName Name of the global "data" array for the file dialog.
+# type "Save" or "Open"
+# argList Options parsed by the procedure.
+#
+# Results:
+# Pathname of the file dialog.
+
+proc tkMotifFDialog_Create {dataName type argList} {
+ global tkPriv
+ upvar ::tk::dialog::file::$dataName data
- tkMotifFDialog_Config $w $type $args
+ tkMotifFDialog_Config $dataName $type $argList
- if {![string compare $data(-parent) .]} {
- set w .$w
+ if {[string equal $data(-parent) .]} {
+ set w .$dataName
} else {
- set w $data(-parent).$w
+ set w $data(-parent).$dataName
}
# (re)create the dialog box if necessary
#
if {![winfo exists $w]} {
- tkMotifFDialog_Create $w
+ tkMotifFDialog_BuildUI $w
} elseif {[string compare [winfo class $w] TkMotifFDialog]} {
destroy $w
- tkMotifFDialog_Create $w
+ tkMotifFDialog_BuildUI $w
} else {
set data(fEnt) $w.top.f1.ent
set data(dList) $w.top.f2.a.l
@@ -60,58 +102,35 @@ proc tkMotifFDialog {args} {
set data(filterBtn) $w.bot.filter
set data(cancelBtn) $w.bot.cancel
}
+
wm transient $w $data(-parent)
tkMotifFDialog_Update $w
- # 5. Withdraw the window, then update all the geometry information
+ # Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
- # display and de-iconify it.
-
- wm withdraw $w
- update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w +$x+$y
- wm deiconify $w
- wm title $w $data(-title)
-
- # 6. Set a grab and claim the focus too.
+ # display (Motif style) and de-iconify it.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {$oldGrab != ""} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- focus $data(sEnt)
- $data(sEnt) select from 0
- $data(sEnt) select to end
-
- # 7. Wait for the user to respond, then restore the focus and
- # return the index of the selected button. Restore the focus
- # before deleting the window, since otherwise the window manager
- # may take the focus away so we can't redirect it. Finally,
- # restore any grab that was in effect.
+ ::tk::PlaceWindow $w
+ wm title $w $data(-title)
- tkwait variable tkPriv(selectFilePath)
- catch {focus $oldFocus}
- grab release $w
- wm withdraw $w
- if {$oldGrab != ""} {
- if {$grabStatus == "global"} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
- return $tkPriv(selectFilePath)
+ return $w
}
-proc tkMotifFDialog_Config {w type argList} {
- upvar #0 $w data
+# tkMotifFDialog_Config --
+#
+# Iterates over the optional arguments to determine the option
+# values for the Motif file dialog; gives default values to
+# unspecified options.
+#
+# Arguments:
+# dataName The name of the global variable in which
+# data for the file dialog is stored.
+# type "Save" or "Open"
+# argList Options parsed by the procedure.
+
+proc tkMotifFDialog_Config {dataName type argList} {
+ upvar ::tk::dialog::file::$dataName data
set data(type) $type
@@ -136,10 +155,10 @@ proc tkMotifFDialog_Config {w type argList} {
# 3: parse the arguments
#
- tclParseConfigSpec $w $specs "" $argList
+ tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
- if {![string compare $data(-title) ""]} {
- if {![string compare $type "open"]} {
+ if {[string equal $data(-title) ""]} {
+ if {[string equal $type "open"]} {
set data(-title) "Open"
} else {
set data(-title) "Save As"
@@ -179,11 +198,21 @@ proc tkMotifFDialog_Config {w type argList} {
}
}
-proc tkMotifFDialog_Create {w} {
+# tkMotifFDialog_BuildUI --
+#
+# Builds the UI components of the Motif file dialog.
+#
+# Arguments:
+# w Pathname of the dialog to build.
+#
+# Results:
+# None.
+
+proc tkMotifFDialog_BuildUI {w} {
set dataName [lindex [split $w .] end]
- upvar #0 $dataName data
+ upvar ::tk::dialog::file::$dataName data
- # 1: Create the dialog ...
+ # Create the dialog toplevel and internal frames.
#
toplevel $w -class TkMotifFDialog
set top [frame $w.top -relief raised -bd 1]
@@ -235,41 +264,53 @@ proc tkMotifFDialog_Create {w} {
# The buttons
#
set data(okBtn) [button $bot.ok -text OK -width 6 -under 0 \
- -command "tkMotifFDialog_OkCmd $w"]
+ -command [list tkMotifFDialog_OkCmd $w]]
set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
- -command "tkMotifFDialog_FilterCmd $w"]
+ -command [list tkMotifFDialog_FilterCmd $w]]
set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
- -command "tkMotifFDialog_CancelCmd $w"]
+ -command [list tkMotifFDialog_CancelCmd $w]]
pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
-side left
# Create the bindings:
#
- bind $w <Alt-t> "focus $data(fEnt)"
- bind $w <Alt-d> "focus $data(dList)"
- bind $w <Alt-l> "focus $data(fList)"
- bind $w <Alt-s> "focus $data(sEnt)"
+ bind $w <Alt-t> [list focus $data(fEnt)]
+ bind $w <Alt-d> [list focus $data(dList)]
+ bind $w <Alt-l> [list focus $data(fList)]
+ bind $w <Alt-s> [list focus $data(sEnt)]
- bind $w <Alt-o> "tkButtonInvoke $bot.ok "
- bind $w <Alt-f> "tkButtonInvoke $bot.filter"
- bind $w <Alt-c> "tkButtonInvoke $bot.cancel"
+ bind $w <Alt-o> [list tkButtonInvoke $bot.ok]
+ bind $w <Alt-f> [list tkButtonInvoke $bot.filter]
+ bind $w <Alt-c> [list tkButtonInvoke $bot.cancel]
- bind $data(fEnt) <Return> "tkMotifFDialog_ActivateFEnt $w"
- bind $data(sEnt) <Return> "tkMotifFDialog_ActivateSEnt $w"
+ bind $data(fEnt) <Return> [list tkMotifFDialog_ActivateFEnt $w]
+ bind $data(sEnt) <Return> [list tkMotifFDialog_ActivateSEnt $w]
- wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
+ wm protocol $w WM_DELETE_WINDOW [list tkMotifFDialog_CancelCmd $w]
}
-proc tkMotifFDialog_MakeSList {w f label under cmd} {
+# tkMotifFDialog_MakeSList --
+#
+# Create a scrolled-listbox and set the keyboard accelerator
+# bindings so that the list selection follows what the user
+# types.
+#
+# Arguments:
+# w Pathname of the dialog box.
+# f Frame widget inside which to create the scrolled
+# listbox. This frame widget already exists.
+# label The string to display on top of the listbox.
+# under Sets the -under option of the label.
+# cmdPrefix Specifies procedures to call when the listbox is
+# browsed or activated.
+
+proc tkMotifFDialog_MakeSList {w f label under cmdPrefix} {
label $f.lab -text $label -under $under -anchor w
listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
- -xscrollcommand "$f.h set" \
- -yscrollcommand "$f.v set"
- scrollbar $f.v -orient vertical -takefocus 0 \
- -command "$f.l yview"
- scrollbar $f.h -orient horizontal -takefocus 0 \
- -command "$f.l xview"
+ -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
@@ -283,29 +324,191 @@ proc tkMotifFDialog_MakeSList {w f label under cmd} {
# bindings for the listboxes
#
set list $f.l
- bind $list <Up> "tkMotifFDialog_Browse$cmd $w"
- bind $list <Down> "tkMotifFDialog_Browse$cmd $w"
- bind $list <space> "tkMotifFDialog_Browse$cmd $w"
- bind $list <1> "tkMotifFDialog_Browse$cmd $w"
- bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w"
- bind $list <Double-1> "tkMotifFDialog_Activate$cmd $w"
- bind $list <Return> "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w"
-
- bindtags $list "Listbox $list [winfo toplevel $list] all"
+ bind $list <Up> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <Down> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <space> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <1> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <B1-Motion> [list tkMotifFDialog_Browse$cmdPrefix $w]
+ bind $list <Double-ButtonRelease-1> \
+ [list tkMotifFDialog_Activate$cmdPrefix $w]
+ bind $list <Return> "tkMotifFDialog_Browse$cmdPrefix [list $w]; \
+ tkMotifFDialog_Activate$cmdPrefix [list $w]"
+
+ bindtags $list [list Listbox $list [winfo toplevel $list] all]
tkListBoxKeyAccel_Set $list
return $f.l
}
+# tkMotifFDialog_InterpFilter --
+#
+# Interpret the string in the filter entry into two components:
+# the directory and the pattern. If the string is a relative
+# pathname, give a warning to the user and restore the pattern
+# to original.
+#
+# Arguments:
+# w pathname of the dialog box.
+#
+# Results:
+# A list of two elements. The first element is the directory
+# specified # by the filter. The second element is the filter
+# pattern itself.
+
+proc tkMotifFDialog_InterpFilter {w} {
+ upvar ::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]
+}
+
+# tkMotifFDialog_Update
+#
+# Load the files and synchronize the "filter" and "selection" fields
+# boxes.
+#
+# Arguments:
+# w pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc tkMotifFDialog_Update {w} {
+ upvar ::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)]
+
+ tkMotifFDialog_LoadFiles $w
+}
+
+# tkMotifFDialog_LoadFiles --
+#
+# Loads the files and directories into the two listboxes according
+# to the filter setting.
+#
+# Arguments:
+# w pathname of the dialog box.
+#
+# Results:
+# None.
+
+proc tkMotifFDialog_LoadFiles {w} {
+ upvar ::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 list
+ #
+ foreach f [lsort -dictionary [glob -nocomplain .* *]] {
+ if {[file isdir ./$f]} {
+ $data(dList) insert end $f
+ }
+ }
+ # Make the file list
+ #
+ if {[string equal $data(filter) *]} {
+ set files [lsort -dictionary [glob -nocomplain .* *]]
+ } else {
+ set files [lsort -dictionary \
+ [glob -nocomplain $data(filter)]]
+ }
+
+ set top 0
+ foreach f $files {
+ if {![file isdir ./$f]} {
+ regsub {^[.]/} $f "" f
+ $data(fList) insert end $f
+ if {[string match .* $f]} {
+ incr top
+ }
+ }
+ }
+
+ # The user probably doesn't want to see the . files. We adjust the view
+ # so that the listbox displays all the non-dot files
+ $data(fList) yview $top
+
+ cd $appPWD
+}
+
+# tkMotifFDialog_BrowseFList --
+#
+# This procedure is called when the directory list is browsed
+# (clicked-over) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
proc tkMotifFDialog_BrowseDList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
focus $data(dList)
- if {![string compare [$data(dList) curselection] ""]} {
+ if {[string equal [$data(dList) curselection] ""]} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
- if {![string compare $subdir ""]} {
+ if {[string equal $subdir ""]} {
return
}
@@ -314,16 +517,17 @@ proc tkMotifFDialog_BrowseDList {w} {
set list [tkMotifFDialog_InterpFilter $w]
set data(filter) [lindex $list 1]
- case $subdir {
+ switch -- $subdir {
. {
- set newSpec [file join $data(selectPath) $data(filter)]
+ set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
}
.. {
- set newSpec [file join [file dirname $data(selectPath)] \
+ set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
$data(filter)]
}
default {
- set newSpec [file join $data(selectPath) $subdir $data(filter)]
+ set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
+ $data(selectPath) $subdir] $data(filter)]
}
}
@@ -331,20 +535,31 @@ proc tkMotifFDialog_BrowseDList {w} {
$data(fEnt) insert 0 $newSpec
}
+# tkMotifFDialog_ActivateDList --
+#
+# This procedure is called when the directory list is activated
+# (double-clicked) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
proc tkMotifFDialog_ActivateDList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
- if {![string compare [$data(dList) curselection] ""]} {
+ if {[string equal [$data(dList) curselection] ""]} {
return
}
set subdir [$data(dList) get [$data(dList) curselection]]
- if {![string compare $subdir ""]} {
+ if {[string equal $subdir ""]} {
return
}
$data(fList) selection clear 0 end
- case $subdir {
+ switch -- $subdir {
. {
set newDir $data(selectPath)
}
@@ -352,7 +567,7 @@ proc tkMotifFDialog_ActivateDList {w} {
set newDir [file dirname $data(selectPath)]
}
default {
- set newDir [file join $data(selectPath) $subdir]
+ set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
}
}
@@ -368,45 +583,80 @@ proc tkMotifFDialog_ActivateDList {w} {
}
}
+# tkMotifFDialog_BrowseFList --
+#
+# This procedure is called when the file list is browsed
+# (clicked-over) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
proc tkMotifFDialog_BrowseFList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
focus $data(fList)
- if {![string compare [$data(fList) curselection] ""]} {
+ if {[string equal [$data(fList) curselection] ""]} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
- if {![string compare $data(selectFile) ""]} {
+ if {[string equal $data(selectFile) ""]} {
return
}
$data(dList) selection clear 0 end
$data(fEnt) delete 0 end
- $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
+ $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
$data(fEnt) xview end
$data(sEnt) delete 0 end
- $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
+ $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
+ $data(selectFile)]
$data(sEnt) xview end
}
+# tkMotifFDialog_ActivateFList --
+#
+# This procedure is called when the file list is activated
+# (double-clicked) by the user.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
proc tkMotifFDialog_ActivateFList {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
- if {![string compare [$data(fList) curselection] ""]} {
+ if {[string equal [$data(fList) curselection] ""]} {
return
}
set data(selectFile) [$data(fList) get [$data(fList) curselection]]
- if {![string compare $data(selectFile) ""]} {
+ if {[string equal $data(selectFile) ""]} {
return
} else {
tkMotifFDialog_ActivateSEnt $w
}
}
+# tkMotifFDialog_ActivateFEnt --
+#
+# This procedure is called when the user presses Return inside
+# the "filter" entry. It updates the dialog according to the
+# text inside the filter entry.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
+
proc tkMotifFDialog_ActivateFEnt {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
set list [tkMotifFDialog_InterpFilter $w]
set data(selectPath) [lindex $list 0]
@@ -415,45 +665,28 @@ proc tkMotifFDialog_ActivateFEnt {w} {
tkMotifFDialog_Update $w
}
-proc tkMotifFDialog_InterpFilter {w} {
- upvar #0 [winfo name $w] data
-
- set text [string trim [$data(fEnt) get]]
- # Perform tilde substitution
- #
- if {![string compare [string index $text 0] ~]} {
- set list [file split $text]
- set tilde [lindex $list 0]
- catch {
- set tilde [glob $tilde]
- }
- set text [eval file join [concat $tilde [lrange $list 1 end]]]
- }
-
- set resolved [file join [file dirname $text] [file tail $text]]
-
- if {[file isdirectory $resolved]} {
- set dir $resolved
- set fil $data(filter)
- } else {
- set dir [file dirname $resolved]
- set fil [file tail $resolved]
- }
-
- return [list $dir $fil]
-}
-
+# tkMotifFDialog_ActivateSEnt --
+#
+# This procedure is called when the user presses Return inside
+# the "selection" entry. It sets the tkPriv(selectFilePath) global
+# variable so that the vwait loop in tkMotifFDialog will be
+# terminated.
+#
+# Arguments:
+# w The pathname of the dialog box.
+#
+# Results:
+# None.
proc tkMotifFDialog_ActivateSEnt {w} {
global tkPriv
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
set selectFilePath [string trim [$data(sEnt) get]]
set selectFile [file tail $selectFilePath]
set selectPath [file dirname $selectFilePath]
-
- if {![string compare $selectFilePath ""]} {
+ if {[string equal $selectFilePath ""]} {
tkMotifFDialog_FilterCmd $w
return
}
@@ -478,19 +711,19 @@ proc tkMotifFDialog_ActivateSEnt {w} {
}
if {![file exists $selectFilePath]} {
- if {![string compare $data(type) open]} {
+ if {[string equal $data(type) open]} {
tk_messageBox -icon warning -type ok \
-message "File \"$selectFilePath\" does not exist."
return
}
} else {
- if {![string compare $data(type) save]} {
+ if {[string equal $data(type) save]} {
set message [format %s%s \
"File \"$selectFilePath\" already exists.\n\n" \
"Replace existing file?"]
set answer [tk_messageBox -icon warning -type yesno \
-message $message]
- if {![string compare $answer "no"]} {
+ if {[string equal $answer "no"]} {
return
}
}
@@ -503,13 +736,13 @@ proc tkMotifFDialog_ActivateSEnt {w} {
proc tkMotifFDialog_OkCmd {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
tkMotifFDialog_ActivateSEnt $w
}
proc tkMotifFDialog_FilterCmd {w} {
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::[winfo name $w] data
tkMotifFDialog_ActivateFEnt $w
}
@@ -522,79 +755,10 @@ proc tkMotifFDialog_CancelCmd {w} {
set tkPriv(selectPath) ""
}
-# tkMotifFDialog_Update
-#
-# Load the files and synchronize the "filter" and "selection" fields
-# boxes.
-#
-# popup:
-# If this is true, then update the selection field according to the
-# "-selection" flag
-#
-proc tkMotifFDialog_Update {w} {
- upvar #0 [winfo name $w] data
-
- $data(fEnt) delete 0 end
- $data(fEnt) insert 0 [file join $data(selectPath) $data(filter)]
- $data(sEnt) delete 0 end
- $data(sEnt) insert 0 [file join $data(selectPath) $data(selectFile)]
-
- tkMotifFDialog_LoadFiles $w
-}
-
-proc tkMotifFDialog_LoadFiles {w} {
- upvar #0 [winfo name $w] data
-
- $data(dList) delete 0 end
- $data(fList) delete 0 end
-
- set appPWD [pwd]
- if {[catch {
- cd $data(selectPath)
- }]} {
- cd $appPWD
-
- $data(dList) insert end ".."
- return
- }
-
- # Make the dir list
- #
- foreach f [lsort -command tclSortNoCase [glob -nocomplain .* *]] {
- if {[file isdirectory $f]} {
- $data(dList) insert end $f
- }
- }
- # Make the file list
- #
- if {![string compare $data(filter) *]} {
- set files [lsort -command tclSortNoCase [glob -nocomplain .* *]]
- } else {
- set files [lsort -command tclSortNoCase \
- [glob -nocomplain $data(filter)]]
- }
-
- set top 0
- foreach f $files {
- if {![file isdir $f]} {
- $data(fList) insert end $f
- if {[string match .* $f]} {
- incr top
- }
- }
- }
-
- # The user probably doesn't want to see the . files. We adjust the view
- # so that the listbox displays all the non-dot files
- $data(fList) yview $top
-
- cd $appPWD
-}
-
proc tkListBoxKeyAccel_Set {w} {
bind Listbox <Any-KeyPress> ""
- bind $w <Destroy> "tkListBoxKeyAccel_Unset $w"
- bind $w <Any-KeyPress> "tkListBoxKeyAccel_Key $w %A"
+ bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w]
+ bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A]
}
proc tkListBoxKeyAccel_Unset {w} {
@@ -605,6 +769,20 @@ proc tkListBoxKeyAccel_Unset {w} {
catch {unset tkPriv(lbAccel,$w,afterId)}
}
+# tkListBoxKeyAccel_Key--
+#
+# This procedure maintains a list of recently entered keystrokes
+# over a listbox widget. It arranges an idle event to move the
+# selection of the listbox to the entry that begins with the
+# keystrokes.
+#
+# Arguments:
+# w The pathname of the listbox.
+# key The key which the user just pressed.
+#
+# Results:
+# None.
+
proc tkListBoxKeyAccel_Key {w key} {
global tkPriv
@@ -613,7 +791,8 @@ proc tkListBoxKeyAccel_Key {w key} {
catch {
after cancel $tkPriv(lbAccel,$w,afterId)
}
- set tkPriv(lbAccel,$w,afterId) [after 500 tkListBoxKeyAccel_Reset $w]
+ set tkPriv(lbAccel,$w,afterId) [after 500 \
+ [list tkListBoxKeyAccel_Reset $w]]
}
proc tkListBoxKeyAccel_Goto {w string} {
@@ -648,3 +827,5 @@ proc tkListBoxKeyAccel_Reset {w} {
catch {unset tkPriv(lbAccel,$w)}
}
+
+
diff --git a/tk/mac/MW_TkHeader.h b/tk/mac/MW_TkHeader.h
new file mode 100644
index 00000000000..8d2b252b01b
--- /dev/null
+++ b/tk/mac/MW_TkHeader.h
@@ -0,0 +1,45 @@
+/*
+ * MW_TkHeader.h --
+ *
+ * This file is a global header file for the MetroWerks CodeWarrior
+ * environment. It essentially acts as a place to set compiler
+ * flags. See MetroWerks documention for more details.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) MW_TkHeader.h 1.10 96/03/04 11:37:47
+ */
+
+#define MAC_TCL
+#define TK_LIBRARY ":library"
+
+#define NO_GETTOD 1
+#define NO_UNION_WAIT 1
+#define HAVE_UNISTD_H 1
+#define HAS_STDARG 1
+#define HAVE_LIMITS_H
+#define REDO_KEYSYM_LOOKUP
+
+/*
+ * The following two defines are used to prepare for the coming
+ * of Copland.
+ */
+
+#define STRICT_CONTROLS 0
+#define STRICT_WINDOWS 0
+
+/*
+ * Define the following symbol if you want
+ * comprehensive debugging turned on.
+ */
+
+/* #define TCL_DEBUG */
+
+#ifdef TCL_DEBUG
+# define TCL_MEM_DEBUG
+# define TK_TEST
+#endif
+
diff --git a/tk/mac/MW_TkHeader.pch b/tk/mac/MW_TkHeader.pch
index 448025b3dda..6eb9461d5c6 100644
--- a/tk/mac/MW_TkHeader.pch
+++ b/tk/mac/MW_TkHeader.pch
@@ -57,3 +57,4 @@
#include "tk.h"
#include "tkInt.h"
#pragma export off
+
diff --git a/tk/mac/MW_TkOldImgHeader.h b/tk/mac/MW_TkOldImgHeader.h
new file mode 100644
index 00000000000..d0b3194b738
--- /dev/null
+++ b/tk/mac/MW_TkOldImgHeader.h
@@ -0,0 +1,3 @@
+#define USE_OLD_IMAGE
+
+#include "MW_TkHeader.pch"
diff --git a/tk/mac/MW_TkTestHeader.h b/tk/mac/MW_TkTestHeader.h
new file mode 100644
index 00000000000..995e9fd22ff
--- /dev/null
+++ b/tk/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/tk/mac/MW_TkTestHeader.pch b/tk/mac/MW_TkTestHeader.pch
new file mode 100644
index 00000000000..5073c6a55f1
--- /dev/null
+++ b/tk/mac/MW_TkTestHeader.pch
@@ -0,0 +1,64 @@
+/*
+ * 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_TkTestHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_TkTestHeaderCFM68K"
+#else
+#pragma precompile_target "MW_TkTestHeader68K"
+#endif
+
+#define TCL_DEBUG 1
+
+/*#define TCL_THREADS 1*/
+
+#include "tclMacCommonPch.h"
+
+#ifdef TCL_DEBUG
+ #define TK_TEST
+#endif
+
+/*
+ * The following defines are for the Xlib.h file to force
+ * it to generate prototypes in the way we need it. This is
+ * defined here in case X.h & company are ever included before
+ * tk.h.
+ */
+
+#define NeedFunctionPrototypes 1
+#define NeedWidePrototypes 0
+
+/*
+ * Place any includes below that will are needed by the majority of the
+ * and is OK to be in any file in the system.
+ */
+
+#include <tcl.h>
+#pragma export on
+#include "tk.h"
+#include "tkInt.h"
+#pragma export off
+
diff --git a/tk/mac/README b/tk/mac/README
index a906e91b367..be73dc9e009 100644
--- a/tk/mac/README
+++ b/tk/mac/README
@@ -1,4 +1,4 @@
-Tk 8.0.4 for Macintosh
+Tk 8.3 for Macintosh
by Ray Johnson
Scriptics Corporation
@@ -19,102 +19,22 @@ information specific to the Macintosh version of Tcl and Tk. For more
general information please read the README file in the main Tk
directory.
-2. What's new?
--------------
-
-Native Look & Feel!!! We now try really hard to support the
-Macintosh Look & Feel with Tcl/Tk 8.0. We aren't finished but
-it look pretty good. Let me know what are the most "un-mac like"
-problems and I'll fix them as quickly as I can.
-
-The button, checkbutton, radiobutton, and scrollbar widgets actually
-use the Mac toolbox controls. This means that they will track the
-look&feel if you use extension that change the appearance of
-applications (like Aaron.) We also use "system" colors so the default
-backgrounds etc. will also change colors. We plan to support this
-feature - so let me know if something doesn't work quite right.
-Unfortunantly, we are not able to change the colors of buttons under
-MacOS 8. Doing this is discouraged under Appearance, and we will probably
-not implement it anytime soon.
-
-We also now support native menus! By using the new -menu option
-on toplevels you can have a menubar that is cross platform. You
-can also place Tk menus in the Apple and Help menus! Check out
-the documentation for more details. Syd Polk <icepick@eng.sun.com> is
-the author of the new menu code. Feel free to contact him if you
-have questions or comments about the menu mechanism.
-
-As of Tk 8.0.4, MacTk menus will adopt the backgrounds, shape, separator, etc
-of the current theme.
-
-The "tk_messageBox" command on the Macintosh is now much more
-mac-like. I'll probably still need to adjust this more - but it
-looks a hell of alot better than it did before.
-
-I've also added a command that allows you to get more native window
-styles. However, we have yet to decide on a cross platform solution
-to the problem of varying window styles. None the less, I thought
-it would be use full to add the capability in an unsupported means
-to tide you over until a better solution is available. The command
-is called "unsupported1". It can be used in the following way:
-
- toplevel .foo; unsupported1 style .foo zoomDocProc
-
-The above command will create a document window with a zoom box.
-Type "unsupported1 style . ???" to get a list of the supported
-styles. The command works like "wm overrideredirect" - you must
-make the call before the window is mapped.
-
-As always - report the bugs you find - including asthetic ones
-in the look & feel of widgets.
-
3. Mac specific features
------------------------
There are several features or enhancements in Tk that are unique to
-the Macintosh version of Tk. Here is a list of those features and
-pointers to where you can find more information about the feature.
-
-* The menu command has special rules for accessing the Macintosh
- Apple and Help menus. See the menu.m man page for details.
-
-* If you have the special Tcl function "tkAboutDialog" defined, it
- will be called instead of displaying the default About Box in the
- console or other parts of the Wish application. See below for
- details.
-
-* In addition to the standard X cursors, the Mac version of Tk will
- let you use any Mac cursor that is named and installed in your
- application. See the GetCursor.3 man page for details.
-
-* The wish application has a couple of hooks to know about the exit,
- "open document" and "Do Script" Mac High Level events.
- See below for details.
-
-* The command unsupported1 will allow you to set the style of new
- toplevel windows on the Macintosh. It is not really supported.
- See below for details.
-
-* In addition to the standard built-in bitmaps that Tk supports, the
- Mac version of Tk allows you to use several Mac specific icons. See
- the GetBitmap.3 man page for a complete list.
-
-* The send command does not yet work on the Macintosh. We hope to
- have it available in Tk 8.1.
-
-* The -use and -container options almost work. The focus bugs that
- were in Tk8.0 final have been fixed. But there are still some
- known bugs that cause some major problems. Be careful, if you
- decide to use these features. (See bugs.doc for details.)
+the Macintosh version of Tk. The list of these features is
+maintained at
+ http://dev.scriptics.com/software/mac/features.html
4. The Distribution
-------------------
-Macintosh Tk is distributed in three different forms. This
-should make it easier to only download what you need. The
-packages are as follows:
+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:
-mactk8.0.4.sea.hqx
+mactk<version>.sea.hqx
This distribution is a "binary" only release. It contains an
installer program that will install a 68k, PowerPC, or Fat
@@ -122,76 +42,34 @@ mactk8.0.4.sea.hqx
the Tcl & Tk libraries in the Extensions folder inside your
System Folder. (No "INIT"'s or Control Pannels are installed.)
-mactcltk-full-8.0.4.sea.hqx
+mactcltk-full-<version>.sea.hqx
This release contains the full release of Tcl and Tk for the
Macintosh plus the More Files package on which Macintosh Tcl and
Tk rely.
-mactk-source-8.0.4.sea.hqx
+mactk-source-<version>.sea.hqx
This release contains the complete source to Tk for the Macintosh
In addition, Metrowerks CodeWarrior libraries and project files
are included. However, you must already have the More Files
package to compile this code.
-5. Documentation
-----------------
-
-There are now many books available for Tcl. These two provide a good
-introduction to the language. It is a good way to get started
-if you haven't used the language before:
-
- Title: Tcl and the Tk Toolkit
- Author: John K. Ousterhout
- Publisher: Addison-Wesley
- ISBN: 0-201-63337-X
-
- Title: Practical Programming in Tcl and Tk
- Author: Brent Welch
- Publisher: Prentice Hall
- ISBN: 0-13-182007-9
-
-More books are listed at
- http://www.scriptics.com/resource/doc/books/
-
-The "doc" subdirectory contains reference in documentation
-in the "man" format found on most UNIX machines. Unfortunately,
-there is not a suitable way to view these pages on the Macintosh.
-A version suitable for viewing on the Macintosh has yet to be
-developed. We are working are having better documentation for
-the Macintosh platform in the future. However, if you have WWW
-access you may access the Man pages at the following URL:
-
- http://www.scriptics.com/man/tcl8.0/contents.html
-
-Other documentation and sample Tcl scripts can be found at
-the Tcl ftp site:
-
- ftp://ftp.neosoft.com/tcl/
-
-The internet news group comp.lang.tcl is also a valuable
-source of information about Tcl. A mailing list is also
-available (see below).
-
-6. Compiling Tk
+5. Compiling Tk
---------------
In order to compile Macintosh Tk you must have the
following items:
- CodeWarrior Pro 1 or higher (CodeWarrior release 9 or higher can work
- and we have project files, but we are depricating support)
- 8.0.4 was build with CW Pro 3.
- Mac Tcl 8.0 (source)
- (which requires More Files 1.4.2 or 1.4.3)
- Mac Tk 8.0 (source)
+ 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, there is something in the initial release of the CW Pro 2
-linker that rendersthe CFM68K version of Wish very unstable. I am
-working with Metrowerks to resolve the issue.
+As with Tcl, you need to upgrade to the 2.0.1 version of the C
+compilers or later to build the CFM68K version of Tcl/Tk.
Special notes:
@@ -199,108 +77,11 @@ Special notes:
* We are starting to support the new Appearance Manager that shipped
with MacOS 8.0. The Tk 8.0.3 release is the first Tk release
- that supports the Appearance Manager well. Tk 8.0.4 extends this support
+ 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 get the Unix tar file, it will untar into a directory tcl8.0.4. However,
- the Macintosh project files expect the folder to be called tcl8.0. You will need
- to rename the folder to tcl8.0, or change all the paths in the project files.
-
-
-7. About Dialog
----------------
-
-There is now a way to replace the default dialog box for the Wish
-application. If you create the tcl procedure "tkAboutDialog" it will
-be called instead of creating the default dialog box. Your procedure
-is then responsible for displaying a window, removing it, etc. This
-interface is experimental and may change in the future - tell me what
-you think of it.
-
-8. Apple Events
----------------
-
-Tcl/Tk currently doesn't have much in the way of support for Mac
-Apple Events. There is no way to send an apple event (although you
-could write an extension to do this) and no general purpose way to
-recieve apple events. However, there are a couple of hooks for
-dealing with some of the standard apple events.
-
- exit - Generally, Tcl cleans up after it self when you exit.
- However, your application may want to do application specifc
- cleanup like saving a users data. To do this you can rename
- the exit command to something else. Define your own exit
- command to do whatever clean up you like and then call the
- origional exit command. For example,
-
- rename exit __exit
- proc exit {} {
- # Do your clean up hear
- __exit
- }
-
- Both incoming quit events and hitting the Quit menu item
- will call the exit command. However, don't expect you can
- abort the exit. Tk may exit anyway if the exit command it
- calls does not actually quit the application.
- open - The other apple event Tk supports is the open event. The
- open event is sent to Tk if, for example, you drop a file on
- the Wish icon. If you define a Tcl procedure with the name
- "tkOpenDocument" it will be invoked on any Open Document
- events that the application receives. The a list of paths to
- the various documents will be passed to the Tcl function.
- Here is an example,
+If you have comments or Bug reports, use our on-line database at
+ http://dev.scriptics.com/ticket/
- proc tkOpenDocument args {
- foreach file $args {
- # Deal with passed in file path
- }
- }
-
- Note: This isn't every thing you need to do to make your
- application dropable. You must still define a FREF resource
- that makes sense for your application domain. (Out of the
- box, you will not be able to drop files on the Wish
- application. See the Inside Macintosh documentation for
- details about the FREF resource.
-
- do script - This is a way for external applications to drive MacTk, or
- to recieve information from it. From AppleScript, you can say:
-
- tell application "Wish8.0"
- do script "console hide
- pack [button .b1 -text {Hello world} -command exit]"
- end tell
-
- which will get Tk to run the canonical hello world application.
-
-8. unsupported1
----------------
-
-The unsupported1 command is a short term hack we made available to
-allow you to set the window style of a new toplevel window. It works
-much like the "wm overrideredirect" and "wm transient" commands in
-that it must be run before the window it's being applied to is mapped.
-
-The syntax of the command is as follows:
-
- unsupported1 style <window> ?style?
-
-The <window> must be a toplevel window. If the style is not given
-then the current style for the window is returned. If you want to set
-the style you must do so before the window gets mapped for the first
-time. The possible window styles include:
-
- documentProc, dBoxProc, plainDBox, altDBoxProc,
- movableDBoxProc, zoomDocProc, rDocProc, floatProc,
- floatZoomProc, floatSideProc, or floatSideZoomProc
-
-NOTE: this is an unsupported command and it WILL go away in the
-future.
-
-
-If you have comments or Bug reports send them to:
-Jim Ingham
-jingham@cygnus.com
diff --git a/tk/mac/bugs.doc b/tk/mac/bugs.doc
index f6d88aa1c9d..120489d9fbd 100644
--- a/tk/mac/bugs.doc
+++ b/tk/mac/bugs.doc
@@ -1,9 +1,14 @@
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$
We are now very close to passing the test suite for Tk. We are very
@@ -26,7 +31,11 @@ Known bugs:
container, so you can watch that instead.
All the focus bugs in Tk8.0 have been fixed, however.
-* The send command is not yet implemented.
+* 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
@@ -42,4 +51,4 @@ are reported at least once. Send those bug reports in!
-Ray
+Jim
diff --git a/tk/mac/tclets.r b/tk/mac/tclets.r
new file mode 100644
index 00000000000..ce68db49657
--- /dev/null
+++ b/tk/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/tk/mac/tclets.tcl b/tk/mac/tclets.tcl
index 380ad260089..9acb5c786cf 100644
--- a/tk/mac/tclets.tcl
+++ b/tk/mac/tclets.tcl
@@ -213,3 +213,4 @@ proc Start {} {
# Now that everything is defined, lets start the app!
Start
+
diff --git a/tk/mac/tkMac.h b/tk/mac/tkMac.h
index ab7c46f85f1..c6b3044ac84 100644
--- a/tk/mac/tkMac.h
+++ b/tk/mac/tkMac.h
@@ -44,38 +44,14 @@ typedef int (Tk_MacEmbedMakeContainerExistProc) (Tk_Window window);
typedef void (Tk_MacEmbedGetClipProc) (Tk_Window window, RgnHandle rgn);
typedef void (Tk_MacEmbedGetOffsetInParentProc) (Tk_Window window, Point *ulCorner);
-/*
- * Mac Specific functions that are available to extension writers.
- */
-
-EXTERN void Tk_MacSetEmbedHandler _ANSI_ARGS_((
- Tk_MacEmbedRegisterWinProc *registerWinProcPtr,
- Tk_MacEmbedGetGrafPortProc *getPortProcPtr,
- Tk_MacEmbedMakeContainerExistProc *containerExistProcPtr,
- Tk_MacEmbedGetClipProc *getClipProc,
- Tk_MacEmbedGetOffsetInParentProc *getOffsetProc));
-
-
-EXTERN void Tk_MacTurnOffMenus _ANSI_ARGS_ (());
-EXTERN void Tk_MacTkOwnsCursor _ANSI_ARGS_ ((int tkOwnsIt));
-
/*
* These functions are currently in tkMacInt.h. They are just copied over here
* so they can be exported.
*/
-EXTERN void TkMacInitMenus _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void TkMacInitAppleEvents _ANSI_ARGS_((Tcl_Interp *interp));
-
-EXTERN int TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));
-EXTERN int TkMacConvertTkEvent _ANSI_ARGS_((EventRecord *eventPtr,
- Window window));
-EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
- int x, int y, int width, int height, int flags));
-EXTERN void TkMacInvalClipRgns _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkMacHaveAppearance _ANSI_ARGS_((void));
-EXTERN GWorldPtr TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
+#include "tkPlatDecls.h"
#pragma export reset
#endif /* _TKMAC */
+
diff --git a/tk/mac/tkMacAppInit.c b/tk/mac/tkMacAppInit.c
index 1064141a7e0..e57649aa09d 100644
--- a/tk/mac/tkMacAppInit.c
+++ b/tk/mac/tkMacAppInit.c
@@ -23,17 +23,18 @@
#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"
+#include "tclInt.h"
#include "tclMac.h"
#ifdef TK_TEST
-EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+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));
+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;
@@ -54,8 +55,6 @@ short SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
* Prototypes for functions from the tkConsole.c file.
*/
-EXTERN void TkConsoleCreate _ANSI_ARGS_((void));
-EXTERN int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
int devId, char *buffer, long size));
/*
@@ -97,6 +96,15 @@ main(
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);
}
@@ -111,7 +119,7 @@ main(
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -242,7 +250,11 @@ MacintoshInit()
InitGraf(&tcl_macQdPtr->thePort);
InitFonts();
+ if (TkMacHaveAppearance() >= 0x110) {
+ InitFloatingWindows();
+ } else {
InitWindows();
+ }
InitMenus();
InitDialogs((long) NULL);
InitCursor();
@@ -274,8 +286,6 @@ MacintoshInit()
Tcl_MacSetEventProc(TkMacConvertEvent);
- TkConsoleCreate();
-
return TCL_OK;
}
@@ -312,7 +322,7 @@ SetupMainInterp(
if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
== 0) {
- if (TkConsoleInit(interp) == TCL_ERROR) {
+ if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
goto error;
}
}
@@ -326,7 +336,7 @@ SetupMainInterp(
return TCL_OK;
error:
- panic(interp->result);
+ panic(Tcl_GetStringResult(interp));
return TCL_ERROR;
}
@@ -391,3 +401,4 @@ SIOUXHandleOneEvent(EventRecord *event)
{
return 0;
}
+
diff --git a/tk/mac/tkMacAppearanceStubs.c b/tk/mac/tkMacAppearanceStubs.c
new file mode 100644
index 00000000000..0c44864c102
--- /dev/null
+++ b/tk/mac/tkMacAppearanceStubs.c
@@ -0,0 +1,106 @@
+/*
+ * 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.
+ */
+
+#pragma export on
+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;
+}
+
+#pragma export reset
diff --git a/tk/mac/tkMacApplication.r b/tk/mac/tkMacApplication.r
index a22ffb272b8..b73e1eaa300 100644
--- a/tk/mac/tkMacApplication.r
+++ b/tk/mac/tkMacApplication.r
@@ -13,6 +13,8 @@
#include <Types.r>
#include <SysTypes.r>
+#include <Balloons.r>
+#include <BalloonTypes.r>
#include <AEUserTermTypes.r>
/*
@@ -43,14 +45,14 @@ resource 'vers' (1) {
TK_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TK_PATCH_LEVEL,
- TK_PATCH_LEVEL ", by Ray Johnson © 1993-1996" "\n" "Sun Microsystems Labratories"
+ 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,
- "Wish " TK_PATCH_LEVEL " © 1993-1996"
+ "Wish " TK_PATCH_LEVEL " © 1993-1999"
};
#define TK_APP_RESOURCES 128
@@ -110,6 +112,17 @@ resource 'kind' (TK_APP_RESOURCES, "Tcl kind", purgeable) {
}
};
+#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.
@@ -265,3 +278,4 @@ data 'ics4' (TK_APP_RESOURCES, "Tk App", purgeable) {
};
+
diff --git a/tk/mac/tkMacBitmap.c b/tk/mac/tkMacBitmap.c
index 06807a2e581..3626b9794b8 100644
--- a/tk/mac/tkMacBitmap.c
+++ b/tk/mac/tkMacBitmap.c
@@ -3,7 +3,7 @@
*
* This file handles the implementation of native bitmaps.
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * 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.
@@ -82,7 +82,7 @@ static BuiltInIcon builtInIcons[] = {
*
* Results:
* A standard Tcl result. If an error occurs then TCL_ERROR is
- * returned and a message is left in interp->result.
+ * 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
@@ -100,10 +100,12 @@ TkpDefineNativeBitmaps()
char * name;
BuiltInIcon *builtInPtr;
NativeIcon *nativeIconPtr;
+ Tcl_HashTable *tablePtr;
for (builtInPtr = builtInIcons; builtInPtr->name != NULL; builtInPtr++) {
name = Tk_GetUid(builtInPtr->name);
- predefHashPtr = Tcl_CreateHashEntry(&tkPredefBitmapTable, name, &new);
+ tablePtr = TkGetBitmapPredefTable();
+ predefHashPtr = Tcl_CreateHashEntry(tablePtr, name, &new);
if (!new) {
continue;
}
@@ -128,7 +130,7 @@ TkpDefineNativeBitmaps()
*
* Results:
* A standard Tcl result. If an error occurs then TCL_ERROR is
- * returned and a message is left in interp->result.
+ * 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
@@ -188,7 +190,7 @@ TkpCreateNativeBitmap(
*
* Results:
* A standard Tcl result. If an error occurs then TCL_ERROR is
- * returned and a message is left in interp->result.
+ * 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
@@ -200,7 +202,7 @@ TkpCreateNativeBitmap(
Pixmap
TkpGetNativeAppBitmap(
Display *display, /* The display. */
- char *name, /* The name of the bitmap. */
+ CONST char *name, /* The name of the bitmap. */
int *width, /* The width & height of the bitmap. */
int *height)
{
@@ -210,19 +212,28 @@ TkpGetNativeAppBitmap(
GWorldPtr destPort;
Rect destRect;
Handle resource;
- int type;
+ 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;
- c2pstr(name);
- resource = GetNamedResource('cicn', (StringPtr) name);
+ resource = GetNamedResource('cicn', nativeName);
if (resource != NULL) {
type = TYPE3;
} else {
- resource = GetNamedResource('ICON', (StringPtr) name);
+ resource = GetNamedResource('ICON', nativeName);
if (resource != NULL) {
type = TYPE2;
}
}
- p2cstr((StringPtr) name);
if (resource == NULL) {
return NULL;
@@ -266,3 +277,4 @@ TkpGetNativeAppBitmap(
SetGWorld(saveWorld, saveDevice);
return pix;
}
+
diff --git a/tk/mac/tkMacButton.c b/tk/mac/tkMacButton.c
index b06bfc8c2a0..76daa72bccd 100644
--- a/tk/mac/tkMacButton.c
+++ b/tk/mac/tkMacButton.c
@@ -28,7 +28,7 @@
#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
+#define DRAW_BEVEL 3
/*
* The following structures are used to draw our controls. Rather than
@@ -84,18 +84,20 @@ static pascal void UserPaneBackgroundProc(ControlHandle,
* 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));
+ ControlRef controlHandle, CCTabHandle ccTabHandle,
+ RGBColor *saveColorPtr));
static void DrawBufferedControl _ANSI_ARGS_((TkButton *butPtr,
- GWorldPtr destPort, GC gc, Pixmap pixmap));
+ GWorldPtr destPort, GC gc, Pixmap pixmap));
static void InitSampleControls();
static void SetupBevelButton _ANSI_ARGS_((TkButton *butPtr,
- ControlRef controlHandle,
- GWorldPtr destPort, GC gc, Pixmap pixmap));
+ ControlRef controlHandle,
+ GWorldPtr destPort, GC gc, Pixmap pixmap));
static void ChangeBackgroundWindowColor _ANSI_ARGS_((
- WindowRef macintoshWindow, RGBColor rgbColor,
- RGBColor *oldColor));
+ WindowRef macintoshWindow, RGBColor rgbColor,
+ RGBColor *oldColor));
static void ButtonExitProc _ANSI_ARGS_((ClientData clientData));
/*
@@ -128,7 +130,11 @@ TkButton *
TkpCreateButton(
Tk_Window tkwin)
{
- return (TkButton *) ckalloc(sizeof(TkButton));
+ TkButton *buttonPtr;
+ buttonPtr = (TkButton *) ckalloc(sizeof(TkButton));
+ Tk_CreateEventHandler(tkwin, ActivateMask,
+ ButtonEventProc, (ClientData) buttonPtr);
+ return buttonPtr;
}
/*
@@ -171,7 +177,7 @@ TkpDisplayButton(
GDHandle saveDevice;
GWorldPtr destPort;
int drawType, borderWidth;
-
+
GetGWorld(&saveWorld, &saveDevice);
butPtr->flags &= ~REDRAW_PENDING;
@@ -193,17 +199,17 @@ TkpDisplayButton(
offset = (butPtr->type == TYPE_BUTTON) && hasImageOrBitmap;
border = butPtr->normalBorder;
- if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
gc = butPtr->disabledGC;
} else if ((butPtr->type == TYPE_BUTTON)
- && (butPtr->state == tkActiveUid)) {
+ && (butPtr->state == STATE_ACTIVE)) {
gc = butPtr->activeTextGC;
border = butPtr->activeBorder;
} else {
gc = butPtr->normalTextGC;
}
- if ((butPtr->flags & SELECTED) && (butPtr->state != tkActiveUid)
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
&& (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
border = butPtr->selectBorder;
}
@@ -218,10 +224,10 @@ TkpDisplayButton(
relief = butPtr->relief;
if ((butPtr->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn) {
- if (!TkMacHaveAppearance() || !hasImageOrBitmap) {
+ if (!TkMacHaveAppearance() || !hasImageOrBitmap) {
relief = (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN
- : TK_RELIEF_RAISED;
- }
+ : TK_RELIEF_RAISED;
+ }
}
/*
@@ -230,11 +236,11 @@ TkpDisplayButton(
*/
if (butPtr->type == TYPE_BUTTON) {
- Tk_Fill3DRectangle(tkwin, pixmap, butPtr->highlightBorder, 0, 0,
- Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+ 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);
+ Tk_Fill3DRectangle(tkwin, pixmap, butPtr->normalBorder, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
}
if (butPtr->type == TYPE_LABEL) {
@@ -251,21 +257,21 @@ TkpDisplayButton(
* 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
+ * -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;
+ 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;
- }
+ 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 {
@@ -273,15 +279,15 @@ TkpDisplayButton(
drawType = DRAW_CONTROL;
} else if (hasImageOrBitmap) {
if (gc->clip_mask == 0) {
- drawType = DRAW_BEVEL;
+ 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;
- }
+ 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;
@@ -289,13 +295,13 @@ TkpDisplayButton(
}
/*
- * Draw the native portion of the buttons. Start by creating the control
+ * 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())) {
+ ((drawType == DRAW_BEVEL) && TkMacHaveAppearance())) {
borderWidth = 0;
/*
@@ -319,7 +325,7 @@ TkpDisplayButton(
*/
if ((drawType == DRAW_BEVEL) && TkMacHaveAppearance()) {
- /* Empty Body */
+ /* Empty Body */
} else if (butPtr->image != None) {
Tk_SizeOfImage(butPtr->image, &width, &height);
@@ -369,12 +375,12 @@ TkpDisplayButton(
/*
* If the button is disabled with a stipple rather than a special
- * foreground color, generate the stippled effect. If the widget
+ * foreground color, generate the stippled effect. If the widget
* is selected and we use a different background color when selected,
* must temporarily modify the GC.
*/
- if ((butPtr->state == tkDisabledUid)
+ if ((butPtr->state == STATE_DISABLED)
&& ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
&& (butPtr->selectBorder != NULL)) {
@@ -471,7 +477,7 @@ TkpComputeButtonGeometry(
} else {
Tk_FreeTextLayout(butPtr->textLayout);
butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
- butPtr->text, -1, butPtr->wrapLength,
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
width = butPtr->textWidth;
@@ -504,7 +510,7 @@ TkpComputeButtonGeometry(
/*
* The width and height calculation for Appearance buttons with images &
- * non-Appearance buttons with images is different. In the latter case,
+ * 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.
@@ -516,7 +522,7 @@ TkpComputeButtonGeometry(
*
* 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
+ * 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.
@@ -528,48 +534,48 @@ TkpComputeButtonGeometry(
}
if ((butPtr->type == TYPE_BUTTON)) {
- if ((butPtr->image == None) && (butPtr->bitmap == None)) {
+ if ((butPtr->image == None) && (butPtr->bitmap == None)) {
butPtr->inset = 0;
- if (butPtr->defaultState != tkDisabledUid) {
- butPtr->inset += butPtr->highlightWidth;
- }
- } else if (TkMacHaveAppearance()) {
- butPtr->inset = 0;
- width += (2 * butPtr->borderWidth + 4);
- height += (2 * butPtr->borderWidth + 4);
+ 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 != tkDisabledUid) {
- butPtr->inset += butPtr->highlightWidth;
- }
- }
+ 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) {
+ 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;
- }
- }
+ /*
+ * 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;
}
@@ -629,9 +635,9 @@ DrawBufferedControl(
TkButton *butPtr, /* Tk button. */
GWorldPtr destPort, /* Off screen GWorld. */
GC gc, /* The GC we are drawing into - needed for
- * the bevel button */
+ * the bevel button */
Pixmap pixmap /* The pixmap we are drawing into - needed
- for the bevel button */
+ for the bevel button */
)
{
ControlRef controlHandle;
@@ -639,21 +645,21 @@ DrawBufferedControl(
int windowColorChanged = false;
RGBColor saveBackColor;
int isBevel = 0;
-
+
if (windowRef == NULL) {
- InitSampleControls();
+ 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
+ * 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.portPixMap = destPort->portPixMap;
}
((CWindowPeek) windowRef)->port.portRect = destPort->portRect;
@@ -665,90 +671,90 @@ DrawBufferedControl(
/*
* Set up control in hidden window to match what we need
- * to draw in the buffered window.
+ * 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;
- }
+ 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;
+ 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;
- }
+ 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;
- }
+ 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;
- }
+ 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;
- }
+ controlHandle = checkHandle;
+ ccTabHandle = checkTabHandle;
+ }
break;
}
(**controlHandle).contrlRect.left = butPtr->inset;
(**controlHandle).contrlRect.top = butPtr->inset;
(**controlHandle).contrlRect.right = Tk_Width(butPtr->tkwin)
- - butPtr->inset;
+ - butPtr->inset;
(**controlHandle).contrlRect.bottom = Tk_Height(butPtr->tkwin)
- - butPtr->inset;
+ - butPtr->inset;
/*
* Setting the control visibility by hand does not
@@ -756,16 +762,16 @@ DrawBufferedControl(
*/
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;
- }
+ 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;
@@ -773,37 +779,38 @@ DrawBufferedControl(
(**controlHandle).contrlValue = 0;
}
- if (butPtr->state == tkActiveUid) {
- if (isBevel) {
- (**controlHandle).contrlHilite = kControlButtonPart;
- } else {
+ 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:
+ case TYPE_BUTTON:
(**controlHandle).contrlHilite = kControlButtonPart;
break;
- case TYPE_RADIO_BUTTON:
+ case TYPE_RADIO_BUTTON:
(**controlHandle).contrlHilite = kControlRadioButtonPart;
break;
- case TYPE_CHECK_BUTTON:
+ case TYPE_CHECK_BUTTON:
(**controlHandle).contrlHilite = kControlCheckBoxPart;
break;
}
}
- } else if (butPtr->state == tkDisabledUid) {
- (**controlHandle).contrlHilite = kControlInactivePart;
} else {
(**controlHandle).contrlHilite = kControlNoPart;
}
-
/*
* Before we draw the control we must add the hidden window back to the
* main window list. Otherwise, radiobuttons and checkbuttons will draw
* incorrectly. I don't really know why - but clearly the control draw
- * proc needs to have the controls window in the window list.
+ * 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...
*/
-
- ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
- LMSetWindowList(windowRef);
+ if (!TkMacHaveAppearance()) {
+ ((CWindowPeek) windowRef)->nextWindow = (CWindowPeek) LMGetWindowList();
+ LMSetWindowList(windowRef);
+ }
/*
* Now we can set the port to our doctered up window. We next need
@@ -815,36 +822,36 @@ DrawBufferedControl(
*/
if (TkMacHaveAppearance()) {
- SetPort((GrafPort *) destPort);
+ SetPort((GrafPort *) destPort);
} else {
- SetPort(windowRef);
+ SetPort(windowRef);
}
-
+
windowColorChanged = UpdateControlColors(butPtr, controlHandle,
- ccTabHandle, &saveBackColor);
+ ccTabHandle, &saveBackColor);
if ((butPtr->type == TYPE_BUTTON) && TkMacHaveAppearance()) {
- Boolean isDefault;
-
- if (butPtr->defaultState == tkActiveUid) {
+ Boolean isDefault;
+
+ if (butPtr->defaultState == STATE_ACTIVE) {
isDefault = true;
} else {
isDefault = false;
}
SetControlData(controlHandle, kControlNoPart,
- kControlPushButtonDefaultTag,
- sizeof(isDefault), (Ptr) &isDefault);
+ kControlPushButtonDefaultTag,
+ sizeof(isDefault), (Ptr) &isDefault);
}
if (TkMacHaveAppearance()) {
- DrawControlInCurrentPort(userPaneHandle);
+ DrawControlInCurrentPort(userPaneHandle);
} else {
- Draw1Control(controlHandle);
+ Draw1Control(controlHandle);
}
if (!TkMacHaveAppearance() &&
- (butPtr->type == TYPE_BUTTON) &&
- (butPtr->defaultState == tkActiveUid)) {
+ (butPtr->type == TYPE_BUTTON) &&
+ (butPtr->defaultState == STATE_ACTIVE)) {
Rect box = (**controlHandle).contrlRect;
RGBColor rgbColor;
@@ -866,14 +873,16 @@ DrawBufferedControl(
*/
if (TkMacHaveAppearance()) {
- SetControlVisibility(controlHandle, false, false);
- if (isBevel) {
- KillPicture(bevelButtonContent.u.picture);
- }
- } else {
- (**controlHandle).contrlVis = 0;
- }
- LMSetWindowList((WindowRef) ((CWindowPeek) windowRef)->nextWindow);
+ SetControlVisibility(controlHandle, false, false);
+ if (isBevel) {
+ KillPicture(bevelButtonContent.u.picture);
+ }
+ } else {
+ (**controlHandle).contrlVis = 0;
+ }
+ if (!TkMacHaveAppearance()) {
+ LMSetWindowList((WindowRef) ((CWindowPeek) windowRef)->nextWindow);
+ }
}
/*
@@ -882,8 +891,8 @@ DrawBufferedControl(
* InitSampleControls --
*
* This function initializes a dummy Macintosh window and
- * sample controls to allow drawing Mac controls to any GWorld
- * (including off-screen bitmaps).
+ * sample controls to allow drawing Mac controls to any GWorld
+ * (including off-screen bitmaps).
*
* Results:
* None.
@@ -897,108 +906,134 @@ DrawBufferedControl(
static void
InitSampleControls()
{
- Rect geometry = {0, 0, 10, 10};
- CWindowPeek windowList;
+ 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.
- */
-
- windowRef = NewCWindow(NULL, &geometry, "\pempty", false,
- zoomDocProc, (WindowRef) -1, true, 0);
- if (windowRef == NULL) {
- panic("Can't allocate buffer window.");
- }
+ /*
+ * 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.
- */
+ /*
+ * 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);
+ 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");
- }
+ 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",
+ 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);
+ 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;
+ picParams.version = -2;
+ picParams.hRes = 0x00480000;
+ picParams.vRes = 0x00480000;
+ picParams.srcRect.top = 0;
+ picParams.srcRect.left = 0;
- ((CWindowPeek) windowRef)->visible = true;
- } else {
+ ((CWindowPeek) windowRef)->visible = true;
+ } else {
buttonHandle = NewControl(windowRef, &geometry, "\p",
false, 1, 0, 1, pushButProc, (SInt32) 0);
checkHandle = NewControl(windowRef, &geometry, "\p",
@@ -1010,39 +1045,45 @@ InitSampleControls()
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.
- */
+ /*
+ * 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...
+ */
- windowList = (CWindowPeek) LMGetWindowList();
- if (windowList == (CWindowPeek) windowRef) {
+ if (!TkMacHaveAppearance()) {
+ windowList = (CWindowPeek) LMGetWindowList();
+ if (windowList == (CWindowPeek) windowRef) {
LMSetWindowList((WindowRef) windowList->nextWindow);
- } else {
+ } else {
while ((windowList != NULL)
&& (windowList->nextWindow != (CWindowPeek) windowRef)) {
- windowList = windowList->nextWindow;
+ windowList = windowList->nextWindow;
}
if (windowList != NULL) {
- windowList->nextWindow = windowList->nextWindow->nextWindow;
+ 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.
+ }
+ ((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);
- */
+ oldPixPtr = ((CWindowPeek) windowRef)->port.portPixMap;
+ Tcl_CreateExitHandler(ButtonExitProc, (ClientData) NULL);
+ */
}
@@ -1065,12 +1106,12 @@ InitSampleControls()
void
SetupBevelButton(
TkButton *butPtr, /* Tk button. */
- ControlRef controlHandle, /* The control to set this picture to */
+ 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 */
+ * the bevel button */
Pixmap pixmap /* The pixmap we are drawing into - needed
- for the bevel button */
+ for the bevel button */
)
{
int height, width;
@@ -1079,13 +1120,13 @@ SetupBevelButton(
SetPort((GrafPtr) destPort);
if (butPtr->image != None) {
- Tk_SizeOfImage(butPtr->image,
- &width, &height);
+ Tk_SizeOfImage(butPtr->image,
+ &width, &height);
} else {
- Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap,
- &width, &height);
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap,
+ &width, &height);
}
-
+
if ((butPtr->width > 0) && (butPtr->width < width)) {
width = butPtr->width;
}
@@ -1105,48 +1146,48 @@ SetupBevelButton(
*/
if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) {
- Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height,
- pixmap, 0, 0);
+ 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);
+ 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);
-
+ 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;
+ 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);
+ kControlBevelButtonGraphicAlignTag,
+ sizeof(ControlButtonGraphicAlignment),
+ (char *) &theAlignment);
}
@@ -1156,8 +1197,8 @@ SetupBevelButton(
* SetUserPaneDrawProc --
*
* Utility function to add a UserPaneDrawProc
- * to a userPane control. From MoreControls code
- * from Apple DTS.
+ * to a userPane control. From MoreControls code
+ * from Apple DTS.
*
* Results:
* MacOS system error.
@@ -1168,15 +1209,15 @@ SetupBevelButton(
*--------------------------------------------------------------
*/
pascal OSErr SetUserPaneDrawProc (
- ControlRef control,
- ControlUserPaneDrawProcPtr upp)
+ ControlRef control,
+ ControlUserPaneDrawProcPtr upp)
{
ControlUserPaneDrawUPP myControlUserPaneDrawUPP;
myControlUserPaneDrawUPP = NewControlUserPaneDrawProc(upp);
return SetControlData (control,
- kControlNoPart, kControlUserPaneDrawProcTag,
- sizeof(myControlUserPaneDrawUPP),
- (Ptr) &myControlUserPaneDrawUPP);
+ kControlNoPart, kControlUserPaneDrawProcTag,
+ sizeof(myControlUserPaneDrawUPP),
+ (Ptr) &myControlUserPaneDrawUPP);
}
/*
@@ -1185,7 +1226,7 @@ pascal OSErr SetUserPaneDrawProc (
* SetUserPaneSetUpSpecialBackgroundProc --
*
* Utility function to add a UserPaneBackgroundProc
- * to a userPane control
+ * to a userPane control
*
* Results:
* MacOS system error.
@@ -1203,9 +1244,9 @@ SetUserPaneSetUpSpecialBackgroundProc(
ControlUserPaneBackgroundUPP myControlUserPaneBackgroundUPP;
myControlUserPaneBackgroundUPP = NewControlUserPaneBackgroundProc(upp);
return SetControlData (control, kControlNoPart,
- kControlUserPaneBackgroundProcTag,
- sizeof(myControlUserPaneBackgroundUPP),
- (Ptr) &myControlUserPaneBackgroundUPP);
+ kControlUserPaneBackgroundProcTag,
+ sizeof(myControlUserPaneBackgroundUPP),
+ (Ptr) &myControlUserPaneBackgroundUPP);
}
/*
@@ -1214,7 +1255,7 @@ SetUserPaneSetUpSpecialBackgroundProc(
* UserPaneDraw --
*
* This function draws the background of the user pane that will
- * lie under checkboxes and radiobuttons.
+ * lie under checkboxes and radiobuttons.
*
* Results:
* None.
@@ -1229,9 +1270,9 @@ UserPaneDraw(
ControlRef control,
ControlPartCode cpc)
{
- Rect contrlRect = (**control).contrlRect;
- RGBBackColor (&gUserPaneBackground);
- EraseRect (&contrlRect);
+ Rect contrlRect = (**control).contrlRect;
+ RGBBackColor (&gUserPaneBackground);
+ EraseRect (&contrlRect);
}
/*
@@ -1240,7 +1281,7 @@ UserPaneDraw(
* UserPaneBackgroundProc --
*
* This function sets up the background of the user pane that will
- * lie under checkboxes and radiobuttons.
+ * lie under checkboxes and radiobuttons.
*
* Results:
* None.
@@ -1257,7 +1298,7 @@ UserPaneBackgroundProc(
ControlBackgroundPtr info)
{
if (info->colorDevice) {
- RGBBackColor (&gUserPaneBackground);
+ RGBBackColor (&gUserPaneBackground);
}
}
@@ -1271,8 +1312,8 @@ UserPaneBackgroundProc(
* 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.
+ * Under Appearance, we just set the pointer that will be
+ * used by the UserPaneDrawProc.
*
* Results:
* None.
@@ -1295,7 +1336,7 @@ UpdateControlColors(
/*
* 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
+ * 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
@@ -1304,37 +1345,38 @@ UpdateControlColors(
*/
if (TkMacHaveAppearance() && (butPtr->type == TYPE_BUTTON)) {
- xcolor = Tk_3DBorderColor(butPtr->highlightBorder);
+ xcolor = Tk_3DBorderColor(butPtr->highlightBorder);
} else {
- xcolor = Tk_3DBorderColor(butPtr->normalBorder);
+ xcolor = Tk_3DBorderColor(butPtr->normalBorder);
}
if (TkMacHaveAppearance()) {
- TkSetMacColor(xcolor->pixel, &gUserPaneBackground);
- } else {
- (**ccTabHandle).ccSeed = 0;
- (**ccTabHandle).ccRider = 0;
- (**ccTabHandle).ctSize = 3;
- (**ccTabHandle).ctTable[0].value = cBodyColor;
- TkSetMacColor(xcolor->pixel,
- &(**ccTabHandle).ctTable[0].rgb);
- (**ccTabHandle).ctTable[1].value = cTextColor;
- TkSetMacColor(butPtr->normalFg->pixel,
- &(**ccTabHandle).ctTable[1].rgb);
- (**ccTabHandle).ctTable[2].value = cFrameColor;
- TkSetMacColor(butPtr->highlightColorPtr->pixel,
- &(**ccTabHandle).ctTable[2].rgb);
- SetControlColor(controlHandle, ccTabHandle);
-
- if (((xcolor->pixel >> 24) != CONTROL_BODY_PIXEL) &&
- ((butPtr->type == TYPE_CHECK_BUTTON) ||
- (butPtr->type == TYPE_RADIO_BUTTON))) {
- RGBColor newColor;
+ TkSetMacColor(xcolor->pixel, &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);
- TkSetMacColor(xcolor->pixel, &newColor);
- ChangeBackgroundWindowColor((**controlHandle).contrlOwner,
- newColor, saveColorPtr);
- return true;
- }
+ 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;
@@ -1347,7 +1389,7 @@ UpdateControlColors(
*
* 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
+ * 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.
@@ -1396,6 +1438,42 @@ ChangeBackgroundWindowColor(
}
/*
+ *--------------------------------------------------------------
+ *
+ * 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 --
@@ -1421,7 +1499,7 @@ ButtonExitProc(clientData)
/*
* Restore our dummy window to it's origional state by putting it
- * back in the window list and restoring it's bits. The destroy
+ * back in the window list and restoring it's bits. The destroy
* the controls and window.
*/
@@ -1441,3 +1519,5 @@ ButtonExitProc(clientData)
DisposeWindow(windowRef);
windowRef = NULL;
}
+
+
diff --git a/tk/mac/tkMacClipboard.c b/tk/mac/tkMacClipboard.c
index 88bc423a343..ebc4c33c5aa 100644
--- a/tk/mac/tkMacClipboard.c
+++ b/tk/mac/tkMacClipboard.c
@@ -32,7 +32,7 @@
* Results:
* The return value is a standard Tcl return value.
* If an error occurs (such as no selection exists)
- * then an error message is left in interp->result.
+ * then an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -66,12 +66,17 @@ TkSelGetSelection(
handle = NewHandle(1);
length = GetScrap(handle, 'TEXT', &offset);
if (length > 0) {
+ Tcl_DString encodedText;
+
SetHandleSize(handle, (Size) length + 1);
HLock(handle);
(*handle)[length] = '\0';
-
- result = (*proc)(clientData, interp, *handle);
-
+
+ Tcl_ExternalToUtfDString(NULL, *handle, length, &encodedText);
+ result = (*proc)(clientData, interp,
+ Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
+
HUnlock(handle);
DisposeHandle(handle);
return result;
@@ -119,7 +124,7 @@ XSetSelectionOwner(
* It expects a Tk_Window, even though it only needs a Tk_Display.
*/
- tkwin = (Tk_Window)tkMainWindowList->winPtr;
+ tkwin = (Tk_Window) TkGetMainInfoList()->winPtr;
if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {
@@ -128,7 +133,7 @@ XSetSelectionOwner(
* owner of the clipboard.
*/
- dispPtr = tkMainWindowList->winPtr->dispPtr;
+ dispPtr = TkGetMainInfoList()->winPtr->dispPtr;
if (dispPtr->clipboardActive) {
return;
}
@@ -241,7 +246,7 @@ TkSuspendClipboard()
char *buffer, *p, *endPtr, *buffPtr;
long length;
- dispPtr = tkDisplayList;
+ dispPtr = TkGetDisplayList();
if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
return;
}
@@ -252,6 +257,8 @@ TkSuspendClipboard()
break;
}
if (targetPtr != NULL) {
+ Tcl_DString encodedText;
+
length = 0;
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
@@ -273,7 +280,10 @@ TkSuspendClipboard()
}
ZeroScrap();
- PutScrap(length, 'TEXT', buffer);
+ Tcl_UtfToExternalDString(NULL, buffer, length, &encodedText);
+ PutScrap(Tcl_DStringLength(&encodedText), 'TEXT',
+ Tcl_DStringValue(&encodedText));
+ Tcl_DStringFree(&encodedText);
ckfree(buffer);
}
@@ -283,11 +293,12 @@ TkSuspendClipboard()
* it needs it. (Window list NULL if quiting.)
*/
- if (tkMainWindowList != NULL) {
- Tk_ClearSelection((Tk_Window) tkMainWindowList->winPtr,
- Tk_InternAtom((Tk_Window) tkMainWindowList->winPtr,
+ if (TkGetMainInfoList() != NULL) {
+ Tk_ClearSelection((Tk_Window) TkGetMainInfoList()->winPtr,
+ Tk_InternAtom((Tk_Window) TkGetMainInfoList()->winPtr,
"CLIPBOARD"));
}
return;
}
+
diff --git a/tk/mac/tkMacColor.c b/tk/mac/tkMacColor.c
index ccdc6734469..055121b2ac8 100644
--- a/tk/mac/tkMacColor.c
+++ b/tk/mac/tkMacColor.c
@@ -88,8 +88,7 @@ TkSetMacColor(
case MENU_BACKGROUND_PIXEL:
case MENU_DISABLED_PIXEL:
case MENU_TEXT_PIXEL:
- GetMenuPartColor((pixel >> 24), macColor);
- return true;
+ return GetMenuPartColor((pixel >> 24), macColor);
case APPEARANCE_PIXEL:
return false;
case PIXEL_MAGIC:
@@ -431,8 +430,19 @@ GetMenuPartColor(
RGBColor backColor, foreColor;
GDHandle maxDevice;
Rect globalRect;
- MCEntryPtr mcEntryPtr = GetMCEntry(0, 0);
+ 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) {
@@ -440,21 +450,21 @@ GetMenuPartColor(
} else {
*macColor = mcEntryPtr->mctRGB3;
}
- return 1;
+ return true;
case MENU_ACTIVE_TEXT_PIXEL:
if (mcEntryPtr == NULL) {
macColor->red = macColor->blue = macColor->green = 0xFFFF;
} else {
*macColor = mcEntryPtr->mctRGB2;
}
- return 1;
+ return true;
case MENU_BACKGROUND_PIXEL:
if (mcEntryPtr == NULL) {
macColor->red = macColor->blue = macColor->green = 0xFFFF;
} else {
*macColor = mcEntryPtr->mctRGB2;
}
- return 1;
+ return true;
case MENU_DISABLED_PIXEL:
if (mcEntryPtr == NULL) {
backColor.red = backColor.blue = backColor.green = 0xFFFF;
@@ -480,14 +490,16 @@ GetMenuPartColor(
*macColor = mcEntryPtr->mctRGB2;
}
}
- return 1;
+ return true;
case MENU_TEXT_PIXEL:
if (mcEntryPtr == NULL) {
macColor->red = macColor->green = macColor->blue = 0;
} else {
*macColor = mcEntryPtr->mctRGB3;
}
- return 1;
+ return true;
}
- return 0;
+ return false;
}
+}
+
diff --git a/tk/mac/tkMacConfig.c b/tk/mac/tkMacConfig.c
new file mode 100644
index 00000000000..cf5ba083282
--- /dev/null
+++ b/tk/mac/tkMacConfig.c
@@ -0,0 +1,46 @@
+/*
+ * 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. */
+ char *dbName, /* The option database name. */
+ char *className) /* The name of the option class. */
+{
+ return NULL;
+}
+
diff --git a/tk/mac/tkMacCursor.c b/tk/mac/tkMacCursor.c
index 92ec0054f12..58729c42e24 100644
--- a/tk/mac/tkMacCursor.c
+++ b/tk/mac/tkMacCursor.c
@@ -109,13 +109,23 @@ FindCursorByName(
{
Handle resource;
Str255 curName;
+ int destWrote, inCurLen;
- curName[0] = strlen(string);
- if (curName[0] > 255) {
+ inCurLen = strlen(string);
+ if (inCurLen > 255) {
return;
}
-
- strcpy((char *) curName + 1, string);
+
+ /*
+ * 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) {
@@ -252,7 +262,7 @@ TkCreateCursorFromData(
/*
*----------------------------------------------------------------------
*
- * TkFreeCursor --
+ * TkpFreeCursor --
*
* This procedure is called to release a cursor allocated by
* TkGetCursorByName.
@@ -267,7 +277,7 @@ TkCreateCursorFromData(
*/
void
-TkFreeCursor(
+TkpFreeCursor(
TkCursor *cursorPtr)
{
TkMacCursor *macCursorPtr = (TkMacCursor *) cursorPtr;
@@ -284,8 +294,6 @@ TkFreeCursor(
if (macCursorPtr == gCurrentCursor) {
gCurrentCursor = NULL;
}
-
- ckfree((char *) macCursorPtr);
}
/*
@@ -385,8 +393,10 @@ TkpSetCursor(
*----------------------------------------------------------------------
*/
-void Tk_MacTkOwnsCursor(
+void
+Tk_MacTkOwnsCursor(
int tkOwnsIt)
{
gTkOwnsCursor = tkOwnsIt;
}
+
diff --git a/tk/mac/tkMacCursors.r b/tk/mac/tkMacCursors.r
index 0c5b6cb83f8..6453645b544 100644
--- a/tk/mac/tkMacCursors.r
+++ b/tk/mac/tkMacCursors.r
@@ -128,3 +128,4 @@ data 'crsr' (1001, "fist") {
$"0000"
};
+
diff --git a/tk/mac/tkMacDefault.h b/tk/mac/tkMacDefault.h
index 03ee2d72db9..bd4dfaf8a13 100644
--- a/tk/mac/tkMacDefault.h
+++ b/tk/mac/tkMacDefault.h
@@ -61,7 +61,8 @@
#define DEF_CHKRAD_FG DEF_BUTTON_FG
#define DEF_BUTTON_FONT "system"
#define DEF_BUTTON_HEIGHT "0"
-#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_BUTTON_HIGHLIGHT_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"
@@ -203,6 +204,7 @@
#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"
@@ -288,7 +290,8 @@
#define DEF_MENUBUTTON_FONT "system"
#define DEF_MENUBUTTON_FG BLACK
#define DEF_MENUBUTTON_HEIGHT "0"
-#define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MENUBUTTON_HIGHLIGHT_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
@@ -348,7 +351,8 @@
#define DEF_SCALE_FG_COLOR BLACK
#define DEF_SCALE_FG_MONO BLACK
#define DEF_SCALE_FROM "0"
-#define DEF_SCALE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCALE_HIGHLIGHT_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 ""
@@ -460,3 +464,4 @@
#define DEF_TOPLEVEL_SCREEN ""
#endif /* _TKMACDEFAULT */
+
diff --git a/tk/mac/tkMacDialog.c b/tk/mac/tkMacDialog.c
index 0067a9f7f35..d401039a005 100644
--- a/tk/mac/tkMacDialog.c
+++ b/tk/mac/tkMacDialog.c
@@ -3,13 +3,12 @@
*
* Contains the Mac implementation of the common dialog boxes.
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * 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>
@@ -21,11 +20,20 @@
#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
*/
@@ -36,6 +44,7 @@
#define SAVE_FILE 0
#define OPEN_FILE 1
+#define CHOOSE_FOLDER 2
#define MATCHED 0
#define UNMATCHED 1
@@ -45,45 +54,56 @@
* information about the file dialog and the file filters.
*/
typedef struct _OpenFileData {
- Tcl_Interp * interp;
- char * initialFile; /* default file to appear in the
- * save dialog */
- char * defExt; /* default extension (not used on the
- * Mac) */
FileFilterList fl; /* List of file filters. */
SInt16 curType; /* The filetype currently being
- * listed */
- int isOpen; /* True if this is an Open dialog,
- * false if it is a Save dialog. */
- MenuHandle menu; /* Handle of the menu in the popup*/
- short dialogId; /* resource ID of the dialog */
- int popupId; /* resource ID of the popup */
- short popupItem; /* item number of the popup in the
- * dialog */
+ * 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)
- */
+ * -filetypes option is set). */
} OpenFileData;
+
static pascal Boolean FileFilterProc _ANSI_ARGS_((CInfoPBPtr pb,
void *myData));
-static int GetFileName _ANSI_ARGS_ ((
- ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv, int isOpen ));
-static Boolean MatchOneType _ANSI_ARGS_((CInfoPBPtr pb,
- OpenFileData * myDataPtr, FileFilter * filterPtr));
+static 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 * myDataPtr));
+ DialogPtr theDialog, OpenFileData * myofdPtr));
static int ParseFileDlgArgs _ANSI_ARGS_ ((Tcl_Interp * interp,
- OpenFileData * myDataPtr, int argc, char ** argv,
+ 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;
@@ -92,68 +112,7 @@ static DlgHookYDUPP saveHook = NULL;
/*
*----------------------------------------------------------------------
*
- * EvalArgv --
- *
- * Invokes the Tcl procedure with the arguments. argv[0] is set by
- * the caller of this function. It may be different than cmdName.
- * The TCL command will see argv[0], not cmdName, as its name if it
- * invokes [lindex [info level 0] 0]
- *
- * Results:
- * TCL_ERROR if the command does not exist and cannot be autoloaded.
- * Otherwise, return the result of the evaluation of the command.
- *
- * Side effects:
- * The command may be autoloaded.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-EvalArgv(
- Tcl_Interp *interp, /* Current interpreter. */
- char * cmdName, /* Name of the TCL command to call */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
-{
- Tcl_CmdInfo cmdInfo;
-
- if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
- char * cmdArgv[2];
-
- /*
- * This comand is not in the interpreter yet -- looks like we
- * have to auto-load it
- */
- if (!Tcl_GetCommandInfo(interp, "auto_load", &cmdInfo)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot execute command \"auto_load\"",
- NULL);
- return TCL_ERROR;
- }
-
- cmdArgv[0] = "auto_load";
- cmdArgv[1] = cmdName;
-
- if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){
- return TCL_ERROR;
- }
-
- if (!Tcl_GetCommandInfo(interp, cmdName, &cmdInfo)) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "cannot auto-load command \"",
- cmdName, "\"",NULL);
- return TCL_ERROR;
- }
- }
-
- return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tk_ChooseColorCmd --
+ * Tk_ChooseColorObjCmd --
*
* This procedure implements the color dialog box for the Mac
* platform. See the user documentation for details on what it
@@ -169,23 +128,86 @@ EvalArgv(
*/
int
-Tk_ChooseColorCmd(
+Tk_ChooseColorObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tk_Window parent = Tk_MainWindow(interp);
- char * colorStr = NULL;
- XColor * colorPtr = NULL;
- char * title = "Choose a color:";
- int i, version;
- long response = 0;
- OSErr err = noErr;
- char buff[40];
- static RGBColor in;
+ Tk_Window parent;
+ char *title;
+ int i, picked, srcRead, dstWrote;
+ long response;
+ OSErr err;
static inited = 0;
-
+ static RGBColor in;
+ static char *optionStrings[] = {
+ "-initialcolor", "-parent", "-title", NULL
+ };
+ enum options {
+ COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+ };
+
+ if (inited == 0) {
+ /*
+ * 'in' stores the last color picked. The next time the color dialog
+ * pops up, the last color will remain in the dialog.
+ */
+
+ in.red = 0xffff;
+ in.green = 0xffff;
+ in.blue = 0xffff;
+ inited = 1;
+ }
+
+ parent = (Tk_Window) clientData;
+ title = "Choose a color:";
+ picked = 0;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *option, *value;
+
+ if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ option = Tcl_GetStringFromObj(objv[i], NULL);
+ Tcl_AppendResult(interp, "value for \"", option, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ value = Tcl_GetStringFromObj(objv[i + 1], NULL);
+
+ switch ((enum options) index) {
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
+
+ colorPtr = Tk_GetColor(interp, parent, value);
+ if (colorPtr == NULL) {
+ return TCL_ERROR;
+ }
+ in.red = colorPtr->red;
+ in.green = colorPtr->green;
+ in.blue = colorPtr->blue;
+ Tk_FreeColor(colorPtr);
+ break;
+ }
+ case COLOR_PARENT: {
+ parent = Tk_NameToWindow(interp, value, parent);
+ if (parent == NULL) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case COLOR_TITLE: {
+ title = value;
+ break;
+ }
+ }
+ }
+
/*
* Use the gestalt manager to determine how to bring
* up the color picker. If versin 2.0 isn't available
@@ -194,92 +216,12 @@ Tk_ChooseColorCmd(
*/
err = Gestalt(gestaltColorPicker, &response);
- if ((err == noErr) || (response == 0x0200L)) {
- version = 2;
- } else {
- version = 1;
- }
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-initialcolor", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- colorStr = argv[v];
- } else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
- }
- } else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- title = argv[v];
- } else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -initialcolor, -parent or -title",
- NULL);
- return TCL_ERROR;
- }
- }
-
- if (colorStr) {
- colorPtr = Tk_GetColor(interp, parent, colorStr);
- if (colorPtr == NULL) {
- return TCL_ERROR;
- }
- }
-
- if (!inited) {
- inited = 1;
- in.red = 0xffff;
- in.green = 0xffff;
- in.blue = 0xffff;
- }
- if (colorPtr) {
- in.red = colorPtr->red;
- in.green = colorPtr->green;
- in.blue = colorPtr->blue;
- }
-
- if (version == 1) {
- /*
- * Use version 1.0 of the color picker
- */
-
- RGBColor out;
- Str255 prompt;
- Point point = {-1, -1};
-
- prompt[0] = strlen(title);
- strncpy((char*) prompt+1, title, 255);
-
- if (GetColor(point, prompt, &in, &out)) {
- /*
- * user selected a color
- */
- sprintf(buff, "#%02x%02x%02x", out.red >> 8, out.green >> 8,
- out.blue >> 8);
- Tcl_SetResult(interp, buff, TCL_VOLATILE);
+ if ((err == noErr) && (response == 0x0200L)) {
+ ColorPickerInfo cpinfo;
- /*
- * Save it for the next time
- */
- in.red = out.red;
- in.green = out.green;
- in.blue = out.blue;
- } else {
- Tcl_ResetResult(interp);
- }
- } else {
/*
* Version 2.0 of the color picker is available. Let's use it
*/
- ColorPickerInfo cpinfo;
cpinfo.theColor.profile = 0L;
cpinfo.theColor.color.rgb.red = in.red;
@@ -292,41 +234,50 @@ Tk_ChooseColorCmd(
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;
- cpinfo.prompt[0] = strlen(title);
- strncpy((char*)cpinfo.prompt+1, title, 255);
-
- if ((PickColor(&cpinfo) == noErr) && cpinfo.newColorChosen) {
- sprintf(buff, "#%02x%02x%02x",
- cpinfo.theColor.color.rgb.red >> 8,
- cpinfo.theColor.color.rgb.green >> 8,
- cpinfo.theColor.color.rgb.blue >> 8);
- Tcl_SetResult(interp, buff, TCL_VOLATILE);
-
- in.blue = cpinfo.theColor.color.rgb.red;
- in.green = cpinfo.theColor.color.rgb.green;
- in.blue = cpinfo.theColor.color.rgb.blue;
- } else {
- Tcl_ResetResult(interp);
+ if (GetColor(point, prompt, &in, &out)) {
+ in = out;
+ picked = 1;
}
- }
+ }
+
+ if (picked != 0) {
+ char result[32];
- if (colorPtr) {
- Tk_FreeColor(colorPtr);
+ sprintf(result, "#%02x%02x%02x", in.red >> 8, in.green >> 8,
+ in.blue >> 8);
+ Tcl_AppendResult(interp, result, NULL);
}
-
return TCL_OK;
-
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * Tk_GetOpenFileCmd --
+ * Tk_GetOpenFileObjCmd --
*
* This procedure implements the "open file" dialog box for the
* Mac platform. See the user documentation for details on what
@@ -341,19 +292,141 @@ Tk_ChooseColorCmd(
*/
int
-Tk_GetOpenFileCmd(
+Tk_GetOpenFileObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
+ int i, result, multiple;
+ OpenFileData ofd;
+ Tk_Window parent;
+ Str255 message, title;
+ AEDesc initialDesc = {typeNull, NULL};
+ FSSpec dirSpec;
+ static 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_GetSaveFileCmd --
+ * Tk_GetSaveFileObjCmd --
*
* Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
* instead
@@ -367,18 +440,321 @@ Tk_GetOpenFileCmd(
*/
int
-Tk_GetSaveFileCmd(
+Tk_GetSaveFileObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
+ int i, result;
+ Str255 initialFile;
+ Tk_Window parent;
+ AEDesc initialDesc = {typeNull, NULL};
+ FSSpec dirSpec;
+ Str255 title, message;
+ OpenFileData ofd;
+ static char *saveOptionStrings[] = {
+ "-defaultextension", "-initialdir", "-initialfile",
+ "-message", "-parent", "-title", NULL
+ };
+ enum saveOptions {
+ SAVE_DEFAULT, 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_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 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 = FSpGetDirectoryID(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
@@ -389,8 +765,8 @@ Tk_GetSaveFileCmd(
*
* Side effects:
* If the user selects a file, the native pathname of the file
- * is returned in interp->result. Otherwise an empty string
- * is returned in interp->result.
+ * is returned in the interp's result. Otherwise an empty string
+ * is returned in the interp's result.
*
*----------------------------------------------------------------------
*/
@@ -399,36 +775,308 @@ static int
GetFileName(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv, /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[], /* Argument objects. */
int isOpen) /* true if we should call GetOpenFileName(),
* false if we should call GetSaveFileName() */
{
- int code = TCL_OK;
- int i;
- OpenFileData myData, *myDataPtr;
- StandardFileReply reply;
- Point mypoint;
- Str255 str;
+ return TCL_OK;
+}
- myDataPtr = &myData;
+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;
- if (openFilter == NULL) {
- openFilter = NewFileFilterYDProc(FileFilterProc);
- openHook = NewDlgHookYDProc(OpenHookProc);
- saveHook = NewDlgHookYDProc(OpenHookProc);
+
+ 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);
+ }
+
+
/*
- * 1. Parse the arguments.
+ * Most commands assume that the file dialogs return a single
+ * item, not a list. So only build a list if multiple is true...
*/
- if (ParseFileDlgArgs(interp, myDataPtr, argc, argv, isOpen)
- != TCL_OK) {
- return TCL_ERROR;
+
+ 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;
+ 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 */
+ }
}
+}
+
+static int
+StdGetFile(
+ Tcl_Interp *interp,
+ OpenFileData *ofd,
+ unsigned char *initialFile,
+ int isOpen)
+{
+ int i;
+ StandardFileReply reply;
+ Point mypoint;
+ MenuHandle menu = NULL;
+
/*
- * 2. Set the items in the file types popup.
+ * Set the items in the file types popup.
*/
/*
@@ -436,237 +1084,90 @@ GetFileName(
* left overs from previous invocation of this command
*/
- if (myDataPtr->usePopup) {
- FileFilter * filterPtr;
-
- for (i=CountMItems(myDataPtr->menu); i>0; i--) {
+ 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(myDataPtr->menu, i);
+
+ DeleteMenuItem(menu, i);
}
- if (myDataPtr->fl.filters) {
- for (filterPtr=myDataPtr->fl.filters; filterPtr;
- filterPtr=filterPtr->next) {
- strncpy((char*)str+1, filterPtr->name, 254);
- str[0] = strlen(filterPtr->name);
- AppendMenu(myDataPtr->menu, (ConstStr255Param) str);
- }
+ filterPtr = ofd->fl.filters;
+ if (filterPtr == NULL) {
+ ofd->usePopup = 0;
} else {
- myDataPtr->usePopup = 0;
+ for ( ; filterPtr != NULL; filterPtr = filterPtr->next) {
+ Str255 str;
+
+ StrLength(str) = (unsigned char) strlen(filterPtr->name);
+ strcpy(StrBody(str), filterPtr->name);
+ AppendMenu(menu, str);
+ }
}
}
/*
- * 3. Call the toolbox file dialog function.
+ * Call the toolbox file dialog function.
*/
+
SetPt(&mypoint, -1, -1);
TkpSetCursor(NULL);
-
- if (myDataPtr->isOpen) {
- if (myDataPtr->usePopup) {
- CustomGetFile(openFilter, (short) -1, NULL, &reply,
- myDataPtr->dialogId,
- mypoint, openHook, NULL, NULL, NULL, (void*)myDataPtr);
+ 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 {
- Str255 prompt, def;
-
- strcpy((char*)prompt+1, "Save as");
- prompt[0] = strlen("Save as");
- if (myDataPtr->initialFile) {
- strncpy((char*)def+1, myDataPtr->initialFile, 254);
- def[0] = strlen(myDataPtr->initialFile);
- } else {
- def[0] = 0;
- }
- if (myDataPtr->usePopup) {
+ } 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, def, &reply, myDataPtr->dialogId, mypoint,
- saveHook, NULL, NULL, NULL, myDataPtr);
+ CustomPutFile(prompt, initialFile, &reply, OPEN_BOX,
+ mypoint, saveHook, NULL, NULL, NULL, (void *) ofd);
} else {
- StandardPutFile(prompt, def, &reply);
+ StandardPutFile(prompt, initialFile, &reply);
}
}
- Tcl_ResetResult(interp);
+ /*
+ * Now parse the reply, and populate the Tcl result.
+ */
+
if (reply.sfGood) {
int length;
- Handle pathHandle = NULL;
- char * pathName = NULL;
+ Handle pathHandle;
+ pathHandle = NULL;
FSpPathFromLocation(&reply.sfFile, &length, &pathHandle);
-
if (pathHandle != NULL) {
+ Tcl_DString ds;
+
HLock(pathHandle);
- pathName = (char *) ckalloc((unsigned) (length + 1));
- strcpy(pathName, *pathHandle);
+ Tcl_ExternalToUtfDString(NULL, (char *) *pathHandle, -1, &ds);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
HUnlock(pathHandle);
DisposeHandle(pathHandle);
-
- /*
- * Return the full pathname of the selected file
- */
-
- Tcl_SetResult(interp, pathName, TCL_DYNAMIC);
}
}
-
- done:
- TkFreeFileFilters(&myDataPtr->fl);
- return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ParseFileDlgArgs --
- *
- * Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
- *
- * Results:
- * A standard TCL return value.
- *
- * Side effects:
- * The OpenFileData structure is initialized and modified according
- * to the arguments.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseFileDlgArgs(
- Tcl_Interp * interp, /* Current interpreter. */
- OpenFileData * myDataPtr, /* Information about the file dialog */
- int argc, /* Number of arguments */
- char ** argv, /* Argument strings */
- int isOpen) /* TRUE if this is an "open" dialog */
-{
- int i;
-
- myDataPtr->interp = interp;
- myDataPtr->initialFile = NULL;
- myDataPtr->curType = 0;
-
- TkInitFileFilters(&myDataPtr->fl);
- if (isOpen) {
- myDataPtr->isOpen = 1;
- myDataPtr->usePopup = 1;
- myDataPtr->menu = GetMenu(OPEN_MENU);
- myDataPtr->dialogId = OPEN_BOX;
- myDataPtr->popupId = OPEN_POPUP;
- myDataPtr->popupItem = OPEN_POPUP_ITEM;
- if (myDataPtr->menu == NULL) {
- Debugger();
- }
- } else {
- myDataPtr->isOpen = 0;
- myDataPtr->usePopup = 0;
- }
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-defaultextension", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- myDataPtr->defExt = argv[v];
- }
- else if (strncmp(argv[i], "-filetypes", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- if (TkGetFileFilters(interp, &myDataPtr->fl,argv[v],0) != TCL_OK) {
- return TCL_ERROR;
- }
- }
- else if (strncmp(argv[i], "-initialdir", len)==0) {
- FSSpec dirSpec;
- char * dirName;
- Tcl_DString dstring;
- long dirID;
- OSErr err;
- Boolean isDirectory;
-
- if (v==argc) {goto arg_missing;}
-
- if (Tcl_TranslateFileName(interp, argv[v], &dstring) == NULL) {
- return TCL_ERROR;
- }
- dirName = dstring.string;
- if (FSpLocationFromPath(strlen(dirName), dirName, &dirSpec) !=
- noErr) {
- Tcl_AppendResult(interp, "bad directory \"", argv[v],
- "\"", NULL);
- return TCL_ERROR;
- }
- err = FSpGetDirectoryID(&dirSpec, &dirID, &isDirectory);
- if ((err != noErr) || !isDirectory) {
- Tcl_AppendResult(interp, "bad directory \"", argv[v],
- "\"", NULL);
- return TCL_ERROR;
- }
- /*
- * Make sure you negate -dirSpec.vRefNum because the standard file
- * package wants it that way !
- */
- LMSetSFSaveDisk(-dirSpec.vRefNum);
- LMSetCurDirStore(dirID);
- Tcl_DStringFree(&dstring);
- }
- else if (strncmp(argv[i], "-initialfile", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- myDataPtr->initialFile = argv[v];
- }
- else if (strncmp(argv[i], "-parent", len)==0) {
- /*
- * Ignored on the Mac, but make sure that it's a valid window
- * pathname
- */
- Tk_Window parent;
-
- if (v==argc) {goto arg_missing;}
-
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
- }
- }
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- /*
- * This option is ignored on the Mac because the Mac file
- * dialog do not support titles.
- */
- }
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -defaultextension, ",
- "-filetypes, -initialdir, -initialfile, -parent or -title",
- NULL);
- return TCL_ERROR;
- }
+ if (menu != NULL) {
+ DisposeMenu(menu);
}
return TCL_OK;
-
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
}
-
/*
*----------------------------------------------------------------------
*
@@ -689,7 +1190,7 @@ static pascal short
OpenHookProc(
short item, /* Event description. */
DialogPtr theDialog, /* The dialog where the event occurs. */
- OpenFileData * myDataPtr) /* Information about the file dialog. */
+ OpenFileData *ofdPtr) /* Information about the file dialog. */
{
short ignore;
Rect rect;
@@ -698,29 +1199,29 @@ OpenHookProc(
switch (item) {
case sfHookFirstCall:
- if (myDataPtr->usePopup) {
+ if (ofdPtr->usePopup) {
/*
* Set the popup list to display the selected type.
*/
- GetDialogItem(theDialog, myDataPtr->popupItem,
- &ignore, &handle, &rect);
- SetControlValue((ControlRef) handle, myDataPtr->curType + 1);
+ GetDialogItem(theDialog, ofdPtr->popupItem, &ignore, &handle,
+ &rect);
+ SetControlValue((ControlRef) handle, ofdPtr->curType + 1);
}
return sfHookNullEvent;
case OPEN_POPUP_ITEM:
- if (myDataPtr->usePopup) {
- GetDialogItem(theDialog, myDataPtr->popupItem,
+ if (ofdPtr->usePopup) {
+ GetDialogItem(theDialog, ofdPtr->popupItem,
&ignore, &handle, &rect);
newType = GetCtlValue((ControlRef) handle) - 1;
- if (myDataPtr->curType != newType) {
- if (newType<0 || newType>myDataPtr->fl.numFilters) {
+ 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 {
- myDataPtr->curType = newType;
+ ofdPtr->curType = newType;
}
return sfHookRebuildList;
}
@@ -755,10 +1256,10 @@ FileFilterProc(
void *myData) /* Client data for this file dialog */
{
int i;
- OpenFileData * myDataPtr = (OpenFileData*)myData;
+ OpenFileData * ofdPtr = (OpenFileData*)myData;
FileFilter * filterPtr;
- if (myDataPtr->fl.numFilters == 0) {
+ if (ofdPtr->fl.numFilters == 0) {
/*
* No types have been specified. List all files by default
*/
@@ -772,13 +1273,14 @@ FileFilterProc(
return MATCHED;
}
- if (myDataPtr->usePopup) {
- i = myDataPtr->curType;
- for (filterPtr=myDataPtr->fl.filters; filterPtr && i>0; i--) {
+ if (ofdPtr->usePopup) {
+ i = ofdPtr->curType;
+ for (filterPtr=ofdPtr->fl.filters; filterPtr && i>0; i--) {
filterPtr = filterPtr->next;
}
if (filterPtr) {
- return MatchOneType(pb, myDataPtr, filterPtr);
+ return MatchOneType(pb->hFileInfo.ioNamePtr, pb->hFileInfo.ioFlFndrInfo.fdType,
+ ofdPtr, filterPtr);
} else {
return UNMATCHED;
}
@@ -788,9 +1290,10 @@ FileFilterProc(
* considered matched if it matches any of the file filters.
*/
- for (filterPtr=myDataPtr->fl.filters; filterPtr;
+ for (filterPtr=ofdPtr->fl.filters; filterPtr;
filterPtr=filterPtr->next) {
- if (MatchOneType(pb, myDataPtr, filterPtr) == MATCHED) {
+ if (MatchOneType(pb->hFileInfo.ioNamePtr, pb->hFileInfo.ioFlFndrInfo.fdType,
+ ofdPtr, filterPtr) == MATCHED) {
return MATCHED;
}
}
@@ -817,8 +1320,9 @@ FileFilterProc(
static Boolean
MatchOneType(
- CInfoPBPtr pb, /* Information about the file */
- OpenFileData * myDataPtr, /* Information about this file dialog */
+ 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 */
{
@@ -859,10 +1363,10 @@ MatchOneType(
int len;
char * p, *q, *ext;
- if (pb->hFileInfo.ioNamePtr == NULL) {
+ if (fileNamePtr == NULL) {
continue;
}
- p = (char*)(pb->hFileInfo.ioNamePtr);
+ p = (char*)(fileNamePtr);
len = p[0];
strncpy(filename, p+1, len);
filename[len] = '\0';
@@ -896,7 +1400,7 @@ MatchOneType(
}
for (mfPtr=clausePtr->macTypes; mfPtr; mfPtr=mfPtr->next) {
- if (pb->hFileInfo.ioFlFndrInfo.fdType == mfPtr->type) {
+ if (fileType == mfPtr->type) {
macMatched = 1;
break;
}
@@ -909,31 +1413,5 @@ MatchOneType(
return UNMATCHED;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tk_MessageBoxCmd --
- *
- * This procedure implements the MessageBox window for the
- * Mac platform. See the user documentation for details on what
- * it does.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See user documentation.
- *
- *----------------------------------------------------------------------
- */
-int
-Tk_MessageBoxCmd(
- ClientData clientData, /* Main window associated with interpreter. */
- Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
-{
- return EvalArgv(interp, "tkMessageBox", argc, argv);
-}
+
diff --git a/tk/mac/tkMacDraw.c b/tk/mac/tkMacDraw.c
index cb26d39eb52..0b4a130c28c 100644
--- a/tk/mac/tkMacDraw.c
+++ b/tk/mac/tkMacDraw.c
@@ -23,6 +23,7 @@
#include <Fonts.h>
#include <QDOffscreen.h>
#include "tkMacInt.h"
+#include "tkPort.h"
#ifndef PI
# define PI 3.14159265358979323846
@@ -974,6 +975,26 @@ TkMacSetUpGraphicsPort(
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/
+ */
+ }
}
/*
@@ -1128,3 +1149,46 @@ InvertByte(
}
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/tk/mac/tkMacEmbed.c b/tk/mac/tkMacEmbed.c
index d92a40488cc..72afb1a1856 100644
--- a/tk/mac/tkMacEmbed.c
+++ b/tk/mac/tkMacEmbed.c
@@ -8,7 +8,7 @@
* Currently only Toplevel embedding within the same Tk application is
* allowed on the Macintosh.
*
- * Copyright (c) 1996-97 Sun Microsystems, Inc.
+ * 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.
@@ -217,7 +217,7 @@ TkpMakeWindow(
* Results:
* The return value is normally TCL_OK. If an error occurs (such
* as string not being a valid window spec), then the return value
- * is TCL_ERROR and an error message is left in interp->result if
+ * is TCL_ERROR and an error message is left in the interp's result if
* interp is non-NULL.
*
* Side effects:
@@ -1190,3 +1190,4 @@ EmbedWindowDeleted(winPtr)
}
}
+
diff --git a/tk/mac/tkMacFont.c b/tk/mac/tkMacFont.c
index a23e47d1f84..7a1314f3887 100644
--- a/tk/mac/tkMacFont.c
+++ b/tk/mac/tkMacFont.c
@@ -16,30 +16,383 @@
#include <Windows.h>
#include <Strings.h>
#include <Fonts.h>
+#include <Script.h>
#include <Resources.h>
+#include <TextUtils.h>
#include "tkMacInt.h"
#include "tkFont.h"
-#include "tkPort.h"
/*
- * The following structure represents the Macintosh's' implementation of a
- * font.
+ * 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. */
- short family;
- short size;
- short style;
+ 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;
-static TkFont * AllocMacFont _ANSI_ARGS_((TkFont *tkfont,
- Tk_Window tkwin, int family, int size, int style));
+/*
+ * Procedures used only in this file.
+ */
+
+static FontFamily * AllocFontFamily(CONST MacFont *fontPtr, int family);
+static SubFont * CanUseFallback(MacFont *fontPtr,
+ CONST char *fallbackName, int ch);
+static SubFont * CanUseFallbackWithAliases(MacFont *fontPtr,
+ char *faceName, int ch, Tcl_DString *nameTriedPtr);
+static SubFont * FindSubFontForChar(MacFont *fontPtr, int ch);
+static void FontMapInsert(SubFont *subFontPtr, int ch);
+static void FontMapLoadPage(SubFont *subFontPtr, int row);
+static int FontMapLookup(SubFont *subFontPtr, int ch);
+static void FreeFontFamily(FontFamily *familyPtr);
+static void InitFont(Tk_Window tkwin, int family, int size,
+ int style, MacFont *fontPtr);
+static void InitSubFont(CONST MacFont *fontPtr, int family,
+ SubFont *subFontPtr);
+static void MultiFontDrawText(MacFont *fontPtr,
+ CONST char *source, int numBytes, int x, int y);
+static void ReleaseFont(MacFont *fontPtr);
+static void ReleaseSubFont(SubFont *subFontPtr);
+static int SeenName(CONST char *name, Tcl_DString *dsPtr);
+
+static char * BreakLine(FontFamily *familyPtr, int flags,
+ CONST char *source, int numBytes, int *widthPtr);
+static int GetFamilyNum(CONST char *faceName, short *familyPtr);
+static int GetFamilyOrAliasNum(CONST char *faceName,
+ short *familyPtr);
+static Tcl_Encoding GetFontEncoding(int faceNum, int allowSymbol,
+ int *isSymbolPtr);
+static Tk_Uid GetUtfFaceName(StringPtr faceNameStr);
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependant code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * See comments below.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TkpFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ MenuHandle fontMenu;
+ FontNameMap *tmpFontNameMap, *newFontNameMap, *mapPtr;
+ int i, j, numFonts, fontMapOffset, isSymbol;
+ Str255 nativeName;
+ Tcl_DString ds;
+ Tcl_Encoding encoding;
+ Tcl_Encoding *encodings;
+
+ if (gWorld == NULL) {
+ /*
+ * Do the following one time only.
+ */
+
+ Rect rect = {0, 0, 1, 1};
+
+ SetFractEnable(0);
+
+ /*
+ * Used for saving and restoring state while drawing and measuring.
+ */
+
+ if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
+ panic("TkpFontPkgInit: NewGWorld failed");
+ }
+
+ /*
+ * The name of each font is stored in the encoding of that font.
+ * How would we translate a name from UTF-8 into the native encoding
+ * of the font unless we knew the encoding of that font? We can't.
+ * So, precompute the UTF-8 and native names of all fonts on the
+ * system. The when the user asks for font by its UTF-8 name, we
+ * lookup the name in that table and really ask for the font by its
+ * native name. Any unknown UTF-8 names will be mapped to the system
+ * font.
+ */
+
+ fontMenu = NewMenu('FT', "\px");
+ AddResMenu(fontMenu, 'FONT');
+
+ numFonts = CountMItems(fontMenu);
+ tmpFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * numFonts);
+ encodings = (Tcl_Encoding *) ckalloc(sizeof(Tcl_Encoding) * numFonts);
+
+ mapPtr = tmpFontNameMap;
+ for (i = 0; i < numFonts; i++) {
+ GetMenuItemText(fontMenu, i + 1, nativeName);
+ GetFNum(nativeName, &mapPtr->faceNum);
+ encodings[i] = GetFontEncoding(mapPtr->faceNum, 0, &isSymbol);
+ Tcl_ExternalToUtfDString(encodings[i], StrBody(nativeName),
+ StrLength(nativeName), &ds);
+ mapPtr->utfName = Tk_GetUid(Tcl_DStringValue(&ds));
+ mapPtr->nativeName = (StringPtr) ckalloc(StrLength(nativeName) + 1);
+ memcpy(mapPtr->nativeName, nativeName, StrLength(nativeName) + 1);
+ Tcl_DStringFree(&ds);
+ mapPtr++;
+ }
+ DisposeMenu(fontMenu);
+
+ /*
+ * Reorder FontNameMap so fonts with the preferred encodings are at
+ * the front of the list. The relative order of fonts that all have
+ * the same encoding is preserved. Fonts with unknown encodings get
+ * stuck at the end.
+ */
+
+ newFontNameMap = (FontNameMap *) ckalloc(sizeof(FontNameMap) * (numFonts + 1));
+ fontMapOffset = 0;
+ for (i = 0; encodingList[i] != NULL; i++) {
+ encoding = Tcl_GetEncoding(NULL, encodingList[i]);
+ if (encoding == NULL) {
+ continue;
+ }
+ for (j = 0; j < numFonts; j++) {
+ if (encodings[j] == encoding) {
+ newFontNameMap[fontMapOffset] = tmpFontNameMap[j];
+ fontMapOffset++;
+ Tcl_FreeEncoding(encodings[j]);
+ tmpFontNameMap[j].utfName = NULL;
+ }
+ }
+ Tcl_FreeEncoding(encoding);
+ }
+ for (i = 0; i < numFonts; i++) {
+ if (tmpFontNameMap[i].utfName != NULL) {
+ newFontNameMap[fontMapOffset] = tmpFontNameMap[i];
+ fontMapOffset++;
+ Tcl_FreeEncoding(encodings[i]);
+ }
+ }
+ if (fontMapOffset != numFonts) {
+ panic("TkpFontPkgInit: unexpected number of fonts");
+ }
+
+ mapPtr = &newFontNameMap[numFonts];
+ mapPtr->utfName = NULL;
+ mapPtr->nativeName = NULL;
+ mapPtr->faceNum = 0;
+ ckfree((char *) tmpFontNameMap);
+ ckfree((char *) encodings);
+
+ gFontNameMap = newFontNameMap;
+ }
+}
/*
*---------------------------------------------------------------------------
@@ -73,6 +426,7 @@ TkpGetNativeFont(
CONST char *name) /* Platform-specific font name. */
{
short family;
+ MacFont *fontPtr;
if (strcmp(name, "system") == 0) {
family = GetSysFont();
@@ -81,8 +435,11 @@ TkpGetNativeFont(
} else {
return NULL;
}
-
- return AllocMacFont(NULL, tkwin, family, 0, 0);
+
+ fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
+ InitFont(tkwin, family, 0, 0, fontPtr);
+
+ return (TkFont *) fontPtr;
}
/*
@@ -122,41 +479,47 @@ TkpGetFontFromAttributes(
* 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. */
+ CONST TkFontAttributes *faPtr)
+ /* Set of attributes to match. */
{
- char buf[257];
- size_t len;
- short family, size, style;
-
- if (faPtr->family == NULL) {
- family = 0;
- } else {
- CONST char *familyName;
-
- familyName = faPtr->family;
- if (strcasecmp(familyName, "Times New Roman") == 0) {
- familyName = "Times";
- } else if (strcasecmp(familyName, "Courier New") == 0) {
- familyName = "Courier";
- } else if (strcasecmp(familyName, "Arial") == 0) {
- familyName = "Helvetica";
- }
-
- len = strlen(familyName);
- if (len > 255) {
- len = 255;
+ 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;
+ }
}
- buf[0] = (char) len;
- memcpy(buf + 1, familyName, len);
- buf[len + 1] = '\0';
- GetFNum((StringPtr) buf, &family);
}
-
- size = faPtr->pointsize;
- if (size <= 0) {
- size = GetDefFontSize();
- }
-
+
+ found:
style = 0;
if (faPtr->weight != TK_FW_NORMAL) {
style |= bold;
@@ -167,8 +530,15 @@ TkpGetFontFromAttributes(
if (faPtr->underline) {
style |= underline;
}
-
- return AllocMacFont(tkFontPtr, tkwin, family, size, style);
+ if (tkFontPtr == NULL) {
+ fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
+ } else {
+ fontPtr = (MacFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
+ }
+ InitFont(tkwin, faceNum, faPtr->size, style, fontPtr);
+
+ return (TkFont *) fontPtr;
}
/*
@@ -194,7 +564,10 @@ void
TkpDeleteFont(
TkFont *tkFontPtr) /* Token of font to be deleted. */
{
- ckfree((char *) tkFontPtr);
+ MacFont *fontPtr;
+
+ fontPtr = (MacFont *) tkFontPtr;
+ ReleaseFont(fontPtr);
}
/*
@@ -206,7 +579,7 @@ TkpDeleteFont(
* on the display of the given window.
*
* Results:
- * interp->result is modified to hold a list of all the available
+ * Modifies interp's result object to hold a list of all the available
* font families.
*
* Side effects:
@@ -220,76 +593,54 @@ TkpGetFontFamilies(
Tcl_Interp *interp, /* Interp to hold result. */
Tk_Window tkwin) /* For display to query. */
{
- MenuHandle fontMenu;
- int i;
- char itemText[257];
-
- fontMenu = NewMenu(1, "\px");
- AddResMenu(fontMenu, 'FONT');
-
- for (i = 1; i < CountMItems(fontMenu); i++) {
- /*
- * Each item is a pascal string. Convert it to C and append.
- */
- GetMenuItemText(fontMenu, i, (unsigned char *) itemText);
- itemText[itemText[0] + 1] = '\0';
- Tcl_AppendElement(interp, &itemText[1]);
+ 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);
}
- DisposeMenu(fontMenu);
}
-
/*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * TkMacIsCharacterMissing --
+ * TkpGetSubFonts --
*
- * 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.
+ * A function used by the testing package for querying the actual
+ * screen fonts that make up a font object.
*
* Results:
- * Returns a 1 if the character is missing, a 0 if it is not.
+ * 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.
*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-
-int
-TkMacIsCharacterMissing(
- Tk_Font tkfont, /* The font we are looking in. */
- unsigned int searchChar) /* The character we are looking for. */
+
+void
+TkpGetSubFonts(interp, tkfont)
+ Tcl_Interp *interp; /* Interp to hold result. */
+ Tk_Font tkfont; /* Font object to query. */
{
- MacFont *fontPtr = (MacFont *) tkfont;
- FMInput fm;
- FontRec **fontRecHandle;
-
- fm.family = fontPtr->family;
- fm.size = fontPtr->size;
- fm.face = fontPtr->style;
- fm.needBits = 0;
- fm.device = 0;
- fm.numer.h = fm.numer.v = fm.denom.h = fm.denom.v = 1;
+ int i;
+ Tcl_Obj *resultPtr, *strPtr;
+ MacFont *fontPtr;
+ FontFamily *familyPtr;
+ Str255 nativeName;
- /*
- * This element of the FMOutput structure was changed between the 2.0 & 3.0
- * versions of the Universal Headers.
- */
-
-#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
- fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontResult;
-#else
- fontRecHandle = (FontRec **) FMSwapFont(&fm)->fontHandle;
-#endif
- return *(short *) ((long) &(*fontRecHandle)->owTLoc
- + ((long)((*fontRecHandle)->owTLoc + searchChar
- - (*fontRecHandle)->firstChar) * sizeof(short))) == -1;
+ 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);
+ }
}
-
/*
*---------------------------------------------------------------------------
@@ -302,7 +653,7 @@ TkMacIsCharacterMissing(
* the characters.
*
* Results:
- * The return value is the number of characters from source that
+ * 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.
@@ -316,14 +667,14 @@ TkMacIsCharacterMissing(
int
Tk_MeasureChars(
Tk_Font tkfont, /* Font in which characters will be drawn. */
- CONST char *source, /* Characters to be displayed. Need not be
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. */
- int numChars, /* Maximum number of characters to consider
+ int numBytes, /* Maximum number of bytes to consider
* from source string. */
- int maxLength, /* If > 0, maxLength specifies the longest
+ 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
+ * x-position. If < 0, then line length is
* unbounded and the flags argument is
* ignored. */
int flags, /* Various flag bits OR-ed together:
@@ -336,134 +687,270 @@ Tk_MeasureChars(
int *lengthPtr) /* Filled with x-location just after the
* terminating character. */
{
- short staticWidths[128];
- short *widths;
- CONST char *p, *term;
- int curX, termX, curIdx, sawNonSpace;
MacFont *fontPtr;
+ FontFamily *lastFamilyPtr;
CGrafPtr saveWorld;
GDHandle saveDevice;
+ int curX, curByte;
- if (numChars == 0) {
- *lengthPtr = 0;
- return 0;
- }
-
- if (gWorld == NULL) {
- Rect rect = {0, 0, 1, 1};
+ /*
+ * 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;
- if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
- panic("NewGWorld failed in Tk_MeasureChars");
- }
- }
GetGWorld(&saveWorld, &saveDevice);
SetGWorld(gWorld, NULL);
-
- fontPtr = (MacFont *) tkfont;
- TextFont(fontPtr->family);
+
TextSize(fontPtr->size);
TextFace(fontPtr->style);
- if (maxLength <= 0) {
- *lengthPtr = TextWidth(source, 0, numChars);
- SetGWorld(saveWorld, saveDevice);
- return numChars;
- }
-
- if (numChars > maxLength) {
- /*
- * Assume that all chars are at least 1 pixel wide, so there's no
- * need to measure more characters than there are pixels. This
- * assumption could be refined to an iterative approach that would
- * use that as a starting point and try more chars if necessary (if
- * there actually were some zero-width chars).
- */
-
- numChars = maxLength;
- }
- if (numChars > SHRT_MAX) {
- /*
- * If they are trying to measure more than 32767 chars at one time,
- * it would require several separate measurements.
- */
-
- numChars = SHRT_MAX;
- }
-
- widths = staticWidths;
- if (numChars >= sizeof(staticWidths) / sizeof(staticWidths[0])) {
- widths = (short *) ckalloc((numChars + 1) * sizeof(short));
- }
+ lastFamilyPtr = fontPtr->subFontArray[0].familyPtr;
- MeasureText((short) numChars, source, widths);
-
- if (widths[numChars] <= maxLength) {
- curX = widths[numChars];
- curIdx = numChars;
+ 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 {
- p = term = source;
- curX = termX = 0;
-
- sawNonSpace = !isspace(UCHAR(*p));
- for (curIdx = 1; ; curIdx++) {
- if (isspace(UCHAR(*p))) {
- if (sawNonSpace) {
- term = p;
- termX = widths[curIdx - 1];
- sawNonSpace = 0;
- }
- } else {
- sawNonSpace = 1;
- }
- if (widths[curIdx] > maxLength) {
- curIdx--;
- curX = widths[curIdx];
- break;
+ CONST char *p, *end, *next, *sourceOrig;
+ int widthLeft;
+ FontFamily *thisFamilyPtr;
+ Tcl_UniChar ch;
+ char *rest;
+
+ /*
+ * How many chars will fit in the space allotted?
+ */
+
+ if (maxLength > 32767) {
+ maxLength = 32767;
+ }
+
+ widthLeft = maxLength;
+ sourceOrig = source;
+ end = source + numBytes;
+ for (p = source; p < end; p = next) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisFamilyPtr = FindSubFontForChar(fontPtr, ch)->familyPtr;
+ if (thisFamilyPtr != lastFamilyPtr) {
+ if (p > source) {
+ rest = BreakLine(lastFamilyPtr, flags, source,
+ p - source, &widthLeft);
+ flags &= ~TK_AT_LEAST_ONE;
+ if (rest != NULL) {
+ p = source;
+ break;
+ }
+ }
+ lastFamilyPtr = thisFamilyPtr;
+ source = p;
}
- p++;
}
- if (flags & TK_PARTIAL_OK) {
- curIdx++;
- curX = widths[curIdx];
+
+ if (p > source) {
+ rest = BreakLine(lastFamilyPtr, flags, source, p - source,
+ &widthLeft);
}
- if ((curIdx == 0) && (flags & TK_AT_LEAST_ONE)) {
- /*
- * The space was too small to hold even one character. Since at
- * least one character must always fit on a line, return the width
- * of the first character.
- */
-
- curX = TextWidth(source, 0, 1);
- curIdx = 1;
- } else if (flags & TK_WHOLE_WORDS) {
- /*
- * Break at last word that fits on the line.
- */
-
- if ((flags & TK_AT_LEAST_ONE) && (term == source)) {
- /*
- * The space was too small to hold an entire word. This
- * is the only word on the line, so just return the part of th
- * word that fit.
- */
-
- ;
- } else {
- curIdx = term - source;
- curX = termX;
- }
- }
+
+ if (rest == NULL) {
+ curByte = numBytes;
+ } else {
+ curByte = rest - sourceOrig;
+ }
+ curX = maxLength - widthLeft;
}
- if (widths != staticWidths) {
- ckfree((char *) widths);
- }
+ SetGWorld(saveWorld, saveDevice);
*lengthPtr = curX;
+ return curByte;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * BreakLine --
+ *
+ * Determine where the given line of text should be broken so that it
+ * fits in the specified range. Before calling this function, the
+ * font values and graphics port must be set.
+ *
+ * Results:
+ * The return value is NULL if the specified range is larger that the
+ * space the text needs, and *widthLeftPtr is filled with how much
+ * space is left in the range after measuring the whole text buffer.
+ * Otherwise, the return value is a pointer into the text buffer that
+ * indicates where the line should be broken (up to, but not including
+ * that character), and *widthLeftPtr is filled with how much space is
+ * left in the range after measuring up to that character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static char *
+BreakLine(
+ FontFamily *familyPtr, /* FontFamily that describes the font values
+ * that are already selected into the graphics
+ * port. */
+ int flags, /* Various flag bits OR-ed together:
+ * TK_PARTIAL_OK means include the last char
+ * which only partially fit on this line.
+ * TK_WHOLE_WORDS means stop on a word
+ * boundary, if possible.
+ * TK_AT_LEAST_ONE means return at least one
+ * character even if no characters fit. */
+ CONST char *source, /* UTF-8 string to be displayed. Need not be
+ * '\0' terminated. */
+ int numBytes, /* Maximum number of bytes to consider
+ * from source string. */
+ int *widthLeftPtr) /* On input, specifies size of range into
+ * which characters from source buffer should
+ * be fit. On output, filled with how much
+ * space is left after fitting as many
+ * characters as possible into the range.
+ * Result may be negative if TK_AT_LEAST_ONE
+ * was specified in the flags argument. */
+{
+ Fixed pixelWidth, widthLeft;
+ StyledLineBreakCode breakCode;
+ Tcl_DString runString;
+ long textOffset;
+ Boolean leadingEdge;
+ Point point;
+ int charOffset, thisCharWasDoubleByte;
+ char *p, *end, *typeTable;
- SetGWorld(saveWorld, saveDevice);
+ 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++;
+ }
+ }
- return curIdx;
+ 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);
}
/*
@@ -489,14 +976,14 @@ Tk_DrawChars(
GC gc, /* Graphics context for drawing characters. */
Tk_Font tkfont, /* Font in which characters will be drawn;
* must be the same as font used in GC. */
- CONST char *source, /* Characters to be displayed. Need not be
+ 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 numChars, /* Number of characters in string. */
+ int numBytes, /* Number of bytes in string. */
int x, int y) /* Coordinates at which to place origin of
* string when drawing. */
{
@@ -538,19 +1025,12 @@ Tk_DrawChars(
bufferPort = TkMacGetDrawablePort(pixmap);
SetGWorld(bufferPort, NULL);
- TextFont(fontPtr->family);
- TextSize(fontPtr->size);
- TextFace(fontPtr->style);
-
if (TkSetMacColor(gc->foreground, &macColor) == true) {
RGBForeColor(&macColor);
}
-
ShowPen();
- MoveTo((short) 0, (short) 0);
FillRect(&stippleMap->bounds, &tcl_macQdPtr->white);
- MoveTo((short) x, (short) y);
- DrawText(source, 0, (short) numChars);
+ MultiFontDrawText(fontPtr, source, numBytes, 0, 0);
SetGWorld(destPort, NULL);
CopyDeepMask(&((GrafPtr) bufferPort)->portBits, stippleMap,
@@ -565,18 +1045,13 @@ Tk_DrawChars(
Tk_FreePixmap(display, pixmap);
ckfree(stippleMap->baseAddr);
ckfree((char *)stippleMap);
- } else {
- TextFont(fontPtr->family);
- TextSize(fontPtr->size);
- TextFace(fontPtr->style);
-
+ } else {
if (TkSetMacColor(gc->foreground, &macColor) == true) {
RGBForeColor(&macColor);
}
-
ShowPen();
- MoveTo((short) (macWin->xOff + x), (short) (macWin->yOff + y));
- DrawText(source, 0, (short) numChars);
+ MultiFontDrawText(fontPtr, source, numBytes, macWin->xOff + x,
+ macWin->yOff + y);
}
TextFont(txFont);
@@ -587,92 +1062,1091 @@ Tk_DrawChars(
}
/*
+ *-------------------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+
+/*
*---------------------------------------------------------------------------
*
- * AllocMacFont --
+ * TkMacIsCharacterMissing --
*
- * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
- * Allocates and intializes the memory for a new TkFont that
- * wraps the platform-specific data.
+ * 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 pointer to newly constructed TkFont.
+ * 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 TkFont *
-AllocMacFont(
- TkFont *tkFontPtr, /* If non-NULL, store the information in
- * this existing TkFont structure, rather than
- * allocating a new structure to hold the
- * font; the existing contents of the font
- * will be released. If NULL, a new TkFont
- * structure is allocated. */
+static void
+InitFont(
Tk_Window tkwin, /* For display where font will be used. */
- int family, /* Macintosh font family. */
+ int faceNum, /* Macintosh font number. */
int size, /* Point size for Macintosh font. */
- int style) /* Macintosh style bits. */
+ int style, /* Macintosh style bits. */
+ MacFont *fontPtr) /* Filled with information constructed from
+ * the above arguments. */
{
- char buf[257];
+ Str255 nativeName;
FontInfo fi;
- MacFont *fontPtr;
TkFontAttributes *faPtr;
TkFontMetrics *fmPtr;
CGrafPtr saveWorld;
GDHandle saveDevice;
+ short pixels;
- if (gWorld == NULL) {
- Rect rect = {0, 0, 1, 1};
-
- if (NewGWorld(&gWorld, 0, &rect, NULL, NULL, 0) != noErr) {
- panic("NewGWorld failed in AllocMacFont");
- }
+ if (size == 0) {
+ size = -GetDefFontSize();
}
+ pixels = (short) TkFontGetPixels(tkwin, size);
+
GetGWorld(&saveWorld, &saveDevice);
SetGWorld(gWorld, NULL);
+ TextFont(faceNum);
+ TextSize(pixels);
+ TextFace(style);
- if (tkFontPtr == NULL) {
- fontPtr = (MacFont *) ckalloc(sizeof(MacFont));
- } else {
- fontPtr = (MacFont *) tkFontPtr;
- }
+ GetFontInfo(&fi);
+ GetFontName(faceNum, nativeName);
fontPtr->font.fid = (Font) fontPtr;
- faPtr = &fontPtr->font.fa;
- GetFontName(family, (StringPtr) buf);
- buf[UCHAR(buf[0]) + 1] = '\0';
- faPtr->family = Tk_GetUid(buf + 1);
- faPtr->pointsize = size;
+ faPtr = &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;
- TextFont(family);
- TextSize(size);
- TextFace(style);
- GetFontInfo(&fi);
+ fmPtr = &fontPtr->font.fm;
fmPtr->ascent = fi.ascent;
fmPtr->descent = fi.descent;
fmPtr->maxWidth = fi.widMax;
fmPtr->fixed = (CharWidth('i') == CharWidth('w'));
-
- fontPtr->family = (short) family;
- fontPtr->size = (short) size;
+
+ fontPtr->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;
- return (TkFont *) fontPtr;
+ 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/tk/mac/tkMacHLEvents.c b/tk/mac/tkMacHLEvents.c
index 02708c0d634..69d1610ab33 100644
--- a/tk/mac/tkMacHLEvents.c
+++ b/tk/mac/tkMacHLEvents.c
@@ -228,13 +228,11 @@ OdocHandler(
}
Tcl_DStringInit(&command);
- Tcl_DStringInit(&pathName);
Tcl_DStringAppend(&command, "tkOpenDocument", -1);
for (index = 1; index <= count; index++) {
int length;
Handle fullPath;
- Tcl_DStringSetLength(&pathName, 0);
err = AEGetNthPtr(&fileSpecList, index, typeFSS,
&keyword, &type, (Ptr) &file, sizeof(FSSpec), &actual);
if ( err != noErr ) {
@@ -243,17 +241,17 @@ OdocHandler(
err = FSpPathFromLocation(&file, &length, &fullPath);
HLock(fullPath);
- Tcl_DStringAppend(&pathName, *fullPath, length);
+ Tcl_ExternalToUtfDString(NULL, *fullPath, length, &pathName);
HUnlock(fullPath);
DisposeHandle(fullPath);
- Tcl_DStringAppendElement(&command, pathName.string);
+ Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
+ Tcl_DStringFree(&pathName);
}
- Tcl_GlobalEval(interp, command.string);
+ Tcl_GlobalEval(interp, Tcl_DStringValue(&command));
Tcl_DStringFree(&command);
- Tcl_DStringFree(&pathName);
return noErr;
}
@@ -312,6 +310,7 @@ ScriptHandler(
theErr = -1771;
} else {
if (theDesc.descriptorType == (DescType)'TEXT') {
+ Tcl_DString encodedText;
short length, i;
length = GetHandleSize(theDesc.dataHandle);
@@ -324,7 +323,10 @@ ScriptHandler(
}
HLock(theDesc.dataHandle);
- tclErr = Tcl_GlobalEval(interp, *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;
@@ -361,10 +363,12 @@ ScriptHandler(
if (tclErr >= 0) {
if (tclErr == TCL_OK) {
AEPutParamPtr(reply, keyDirectObject, typeChar,
- interp->result, strlen(interp->result));
+ Tcl_GetStringResult(interp),
+ strlen(Tcl_GetStringResult(interp)));
} else {
AEPutParamPtr(reply, keyErrorString, typeChar,
- interp->result, strlen(interp->result));
+ Tcl_GetStringResult(interp),
+ strlen(Tcl_GetStringResult(interp)));
AEPutParamPtr(reply, keyErrorNumber, typeInteger,
(Ptr) &tclErr, sizeof(int));
}
@@ -435,3 +439,4 @@ MissedAnyParameters(
return (err != errAEDescNotFound);
}
+
diff --git a/tk/mac/tkMacInit.c b/tk/mac/tkMacInit.c
index d78a386462c..d0af8ac3685 100644
--- a/tk/mac/tkMacInit.c
+++ b/tk/mac/tkMacInit.c
@@ -4,7 +4,7 @@
* This file contains Mac-specific interpreter initialization
* functions.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * 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.
@@ -41,7 +41,7 @@ QDGlobalsPtr tcl_macQdPtr = NULL;
*
* Results:
* A standard Tcl completion code (TCL_OK or TCL_ERROR). Also
- * leaves information in interp->result.
+ * leaves information in the interp's result.
*
* Side effects:
* Sets "tk_library" Tcl variable, runs initialization scripts
@@ -238,3 +238,4 @@ TkpDisplayWarning(
panic(Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
}
+
diff --git a/tk/mac/tkMacInt.h b/tk/mac/tkMacInt.h
index bb946cd429b..ab664787a72 100644
--- a/tk/mac/tkMacInt.h
+++ b/tk/mac/tkMacInt.h
@@ -15,12 +15,8 @@
#define _TKMACINT
#include "tkInt.h"
-#include "tkPort.h"
-
-#ifndef _TKMAC
-# include "tkMac.h"
-#endif /* _TKMAC */
+#include "tkMac.h"
#include <AppleEvents.h>
#include <Windows.h>
@@ -208,89 +204,11 @@ typedef TkMenuDefProcPtr TkMenuDefUPP;
(whichItemPtr), (globalsPtr))
#endif
-/*
- * Internal procedures shared among Macintosh Tk modules but not exported
- * to the outside world:
- */
+#include "tkIntPlatDecls.h"
-extern int HandleWMEvent _ANSI_ARGS_((EventRecord *theEvent));
-extern void TkAboutDlg _ANSI_ARGS_((void));
-extern void TkCreateMacEventSource _ANSI_ARGS_((void));
-extern void TkFontList _ANSI_ARGS_((Tcl_Interp *interp,
- Display *display));
-extern Window TkGetTransientMaster _ANSI_ARGS_((TkWindow *winPtr));
-extern int TkGenerateButtonEvent _ANSI_ARGS_((int x, int y,
- Window window, unsigned int state));
-extern int TkGetCharPositions _ANSI_ARGS_((
- XFontStruct *font_struct, char *string,
- int count, short *buffer));
-extern void TkGenWMDestroyEvent _ANSI_ARGS_((Tk_Window tkwin));
-extern void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
- int x, int y, int width, int height, int flags));
-extern unsigned int TkMacButtonKeyState _ANSI_ARGS_((void));
-extern void TkMacClearMenubarActive _ANSI_ARGS_((void));
-extern int TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));
-extern int TkMacDispatchMenuEvent _ANSI_ARGS_((int menuID,
- int index));
-extern void TkMacInstallCursor _ANSI_ARGS_((int resizeOverride));
-extern int TkMacConvertTkEvent _ANSI_ARGS_((EventRecord *eventPtr,
- Window window));
-extern void TkMacHandleTearoffMenu _ANSI_ARGS_((void));
-extern void tkMacInstallMWConsole _ANSI_ARGS_((
- Tcl_Interp *interp));
-extern void TkMacInvalClipRgns _ANSI_ARGS_((TkWindow *winPtr));
-extern void TkMacDoHLEvent _ANSI_ARGS_((EventRecord *theEvent));
-extern void TkMacFontInfo _ANSI_ARGS_((Font fontId, short *family,
- short *style, short *size));
-extern Time TkMacGenerateTime _ANSI_ARGS_(());
-extern GWorldPtr TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
-extern TkWindow * TkMacGetScrollbarGrowWindow _ANSI_ARGS_((
- TkWindow *winPtr));
-extern Window TkMacGetXWindow _ANSI_ARGS_((WindowRef macWinPtr));
-extern int TkMacGrowToplevel _ANSI_ARGS_((WindowRef whichWindow,
- Point start));
-extern void TkMacHandleMenuSelect _ANSI_ARGS_((long mResult,
- int optionKeyPressed));
-extern int TkMacHaveAppearance _ANSI_ARGS_((void));
-extern void TkMacInitAppleEvents _ANSI_ARGS_((Tcl_Interp *interp));
-extern void TkMacInitMenus _ANSI_ARGS_((Tcl_Interp *interp));
-extern void TkMacInvalidateWindow _ANSI_ARGS_((MacDrawable *macWin, int flag));
-extern int TkMacIsCharacterMissing _ANSI_ARGS_((Tk_Font tkfont,
- unsigned int searchChar));
-extern void TkMacMakeRealWindowExist _ANSI_ARGS_((
- TkWindow *winPtr));
-extern BitMapPtr TkMacMakeStippleMap(Drawable, Drawable);
-extern void TkMacMenuClick _ANSI_ARGS_((void));
-extern void TkMacRegisterOffScreenWindow _ANSI_ARGS_((Window window,
- GWorldPtr portPtr));
-extern int TkMacResizable _ANSI_ARGS_((TkWindow *winPtr));
-extern void TkMacSetEmbedRgn _ANSI_ARGS_((TkWindow *winPtr, RgnHandle rgn));
-extern void TkMacSetHelpMenuItemCount _ANSI_ARGS_((void));
-extern void TkMacSetScrollbarGrow _ANSI_ARGS_((TkWindow *winPtr,
- int flag));
-extern void TkMacSetUpClippingRgn _ANSI_ARGS_((Drawable drawable));
-extern void TkMacSetUpGraphicsPort _ANSI_ARGS_((GC gc));
-extern void TkMacUpdateClipRgn _ANSI_ARGS_((TkWindow *winPtr));
-extern void TkMacUnregisterMacWindow _ANSI_ARGS_((GWorldPtr portPtr));
-extern int TkMacUseMenuID _ANSI_ARGS_((short macID));
-extern RgnHandle TkMacVisableClipRgn _ANSI_ARGS_((TkWindow *winPtr));
-extern void TkMacWinBounds _ANSI_ARGS_((TkWindow *winPtr,
- Rect *geometry));
-extern void TkMacWindowOffset _ANSI_ARGS_((WindowRef wRef,
- int *xOffset, int *yOffset));
-extern void TkResumeClipboard _ANSI_ARGS_((void));
-extern int TkSetMacColor _ANSI_ARGS_((unsigned long pixel,
- RGBColor *macColor));
-extern void TkSetWMName _ANSI_ARGS_((TkWindow *winPtr,
- Tk_Uid titleUid));
-extern void TkSuspendClipboard _ANSI_ARGS_((void));
-extern int TkWMGrowToplevel _ANSI_ARGS_((WindowRef whichWindow,
- Point start));
-extern int TkMacZoomToplevel _ANSI_ARGS_((WindowPtr whichWindow,
- Point where, short zoomPart));
-extern Tk_Window Tk_TopCoordsToWindow _ANSI_ARGS_((Tk_Window tkwin,
- int rootX, int rootY, int *newX, int *newY));
-extern MacDrawable * TkMacContainerId _ANSI_ARGS_((TkWindow *winPtr));
-extern MacDrawable * TkMacGetHostToplevel _ANSI_ARGS_((TkWindow *winPtr));
+/* FIXME - This has to go in the tkInt.decls!!! */
+
+int TkpIsWindowFloating _ANSI_ARGS_((WindowRef window));
#endif /* _TKMACINT */
+
diff --git a/tk/mac/tkMacKeyboard.c b/tk/mac/tkMacKeyboard.c
index 44a45d502f2..635e2c70deb 100644
--- a/tk/mac/tkMacKeyboard.c
+++ b/tk/mac/tkMacKeyboard.c
@@ -3,7 +3,7 @@
*
* Routines to support keyboard events on the Macintosh.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * 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.
@@ -137,7 +137,7 @@ XKeycodeToKeysym(
int index)
{
register Tcl_HashEntry *hPtr;
- register char c;
+ int c;
char virtualKey;
int newKeycode;
unsigned long dummy, newChar;
@@ -146,8 +146,11 @@ XKeycodeToKeysym(
InitKeyMaps();
}
- c = keycode & charCodeMask;
- virtualKey = (keycode & keyCodeMask) >> 8;
+ virtualKey = (char) (keycode >> 16);
+ c = (keycode) & 0xffff;
+ if (c > 255) {
+ return NoSymbol;
+ }
/*
* When determining what keysym to produce we firt check to see if
@@ -161,8 +164,6 @@ XKeycodeToKeysym(
return (KeySym) Tcl_GetHashValue(hPtr);
}
}
-
-
hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
if (hPtr != NULL) {
return (KeySym) Tcl_GetHashValue(hPtr);
@@ -190,60 +191,63 @@ XKeycodeToKeysym(
/*
*----------------------------------------------------------------------
*
- * XLookupString --
+ * TkpGetString --
*
* Retrieve the string equivalent for the given keyboard event.
*
* Results:
- * Returns the number of characters stored in buffer_return.
+ * Returns the UTF string.
*
* Side effects:
- * Retrieves the characters stored in the event and inserts them
- * into buffer_return.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-XLookupString(
- XKeyEvent* event_struct,
- char* buffer_return,
- int bytes_buffer,
- KeySym* keysym_return,
- XComposeStatus* status_in_out)
+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;
- char c;
+ int c, len;
if (!initialized) {
InitKeyMaps();
}
-
- c = event_struct->keycode & charCodeMask;
- string[0] = c;
- string[1] = '\0';
+
+ 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) {
- string[0] = '\0';
+ len = 0;
} else {
- virtualKey = (event_struct->keycode & keyCodeMask) >> 8;
hPtr = Tcl_FindHashEntry(&keycodeTable, (char *) virtualKey);
if (hPtr != NULL) {
- string[0] = '\0';
+ len = 0;
}
}
-
- if (buffer_return != NULL) {
- strncpy(buffer_return, string, bytes_buffer);
- }
-
- return strlen(string);
+ return Tcl_ExternalToUtfDString(NULL, string, len, dsPtr);
}
/*
@@ -342,6 +346,8 @@ XStringToKeysym(
* 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.
@@ -377,8 +383,268 @@ XKeysymToKeycode(
virtualKeyCode = 0x24;
keysym = '\r';
}
- keycode = keysym + ((virtualKeyCode << 8) & keyCodeMask);
+ 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/tk/mac/tkMacLibrary.r b/tk/mac/tkMacLibrary.r
index 493dee15657..b5776dc893f 100644
--- a/tk/mac/tkMacLibrary.r
+++ b/tk/mac/tkMacLibrary.r
@@ -54,14 +54,14 @@ resource 'vers' (1) {
TK_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TK_PATCH_LEVEL,
- TK_PATCH_LEVEL ", by Ray Johnson © 1993-1996" "\n" "Sun Microsystems Labratories"
+ 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-1996"
+ "Tk Library " TK_PATCH_LEVEL " © 1993-1999"
};
#define TK_LIBRARY_RESOURCES 3000
@@ -75,7 +75,7 @@ resource 'vers' (2) {
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 "
+ "To work properly, it should be placed in the Tool Command Language folder "
"within the Extensions folder."
};
@@ -138,8 +138,8 @@ resource 'DITL' (129, "About Box", purgeable) {
{128, 128, 148, 186}, Button {enabled, "Ok"},
{ 14, 108, 117, 298}, StaticText {disabled,
"Wish - Windowing Shell" "\n" "based on Tcl "
- TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n" "Ray Johnson"
- "Sun Microsystems Labs" "\n" "ray.johnson@eng.sun.com"},
+ 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}
}
};
@@ -506,3 +506,4 @@ resource 'MENU' (132, preload) {
textMenuProc,
0xFFFF, enabled, "", {}
};
+
diff --git a/tk/mac/tkMacMDEF.c b/tk/mac/tkMacMDEF.c
index 136f1ba8cab..6f4299c0907 100644
--- a/tk/mac/tkMacMDEF.c
+++ b/tk/mac/tkMacMDEF.c
@@ -114,3 +114,4 @@ main(
SELECTRECT = globals.itemRect;
}
}
+
diff --git a/tk/mac/tkMacMDEF.r b/tk/mac/tkMacMDEF.r
index 85f165e2740..104f7bee450 100644
--- a/tk/mac/tkMacMDEF.r
+++ b/tk/mac/tkMacMDEF.r
@@ -43,3 +43,4 @@ data 'MDEF' (591, preload) {
$"4E5E 205F 4FEF 0012 4ED0 846D 6169 6E00" /* N^ _Oï..NЄmain. */
$"0000" /* .. */
};
+
diff --git a/tk/mac/tkMacMenu.c b/tk/mac/tkMacMenu.c
index a3aadcd692f..b4cf8e2324f 100644
--- a/tk/mac/tkMacMenu.c
+++ b/tk/mac/tkMacMenu.c
@@ -11,6 +11,12 @@
* RCS: @(#) $Id$
*/
+#include "tkMacInt.h"
+#include "tkMenuButton.h"
+#include "tkMenu.h"
+#include "tkColor.h"
+#include "tkMacInt.h"
+#undef Status
#include <Menus.h>
#include <OSUtils.h>
#include <Palettes.h>
@@ -19,12 +25,7 @@
#include <ToolUtils.h>
#include <Balloons.h>
#include <Appearance.h>
-#undef Status
#include <Devices.h>
-#include "tkMenu.h"
-#include "tkMacInt.h"
-#include "tkMenuButton.h"
-#include "tkColor.h"
typedef struct MacMenu {
MenuHandle menuHdl; /* The Menu Manager data structure. */
@@ -54,7 +55,7 @@ typedef struct MenuEntryUserData {
* The following are constants relating to the SICNs used for drawing the MDEF.
*/
-#define SICN_RESOURCE_NUMBER 128
+#define SICN_RESOURCE_NUMBER 128
#define SICN_HEIGHT 16
#define SICN_ROWS 2
@@ -176,6 +177,9 @@ static char *currentMenuBarName;
* 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
@@ -192,7 +196,8 @@ static MacDrawable macMDEFDrawable;
static MDEFScrollFlag = 0; /* Used so that popups don't scroll too soon. */
static int menuBarFlags; /* Used for whether the menu bar needs
* redrawing or not. */
-static TkMenuDefUPP menuDefProc;/* The routine descriptor to the MDEF proc.
+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. */
@@ -214,11 +219,6 @@ static TopLevelMenubarList *windowListPtr;
static MenuItemDrawingUPP tkThemeMenuItemDrawingUPP;
/* Points to the UPP for theme Item drawing. */
-static GC appearanceGC = NULL; /* The fake appearance GC. If you
- pass the foreground of this to TkMacSetColor,
- it will return false, so you will know
- not to set the foreground color */
-
/*
* Forward declarations for procedures defined later in this file:
@@ -260,6 +260,8 @@ static void DrawTearoffEntry _ANSI_ARGS_((TkMenu *menuPtr,
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,
@@ -304,6 +306,8 @@ static void RecursivelyInsertMenu _ANSI_ARGS_((
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,
@@ -335,7 +339,7 @@ pascal void tkThemeMenuItemDrawingProc _ANSI_ARGS_ ((const Rect *inBounds,
int
TkMacUseMenuID(
- short macID) /* The id to take out of the table */
+ short macID) /* The id to take out of the table */
{
Tcl_HashEntry *commandEntryPtr;
int newEntry;
@@ -446,6 +450,7 @@ GetNewID(
*menuIDPtr = returnID;
return TCL_OK;
} else {
+ Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "No more menus can be allocated.",
(char *) NULL);
return TCL_ERROR;
@@ -681,7 +686,8 @@ TkpDestroyMenuEntry(
*
* 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.
+ * handled specially. This is primarily used to do a substitution
+ * between "..." and "ƒ".
*
* Results:
* itemText points to the new text for the item.
@@ -695,36 +701,41 @@ TkpDestroyMenuEntry(
static void
GetEntryText(
TkMenuEntry *mePtr, /* A pointer to the menu entry. */
- Str255 itemText) /* The pascal string containing the text */
+ 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) {
- strcpy((char *)itemText, (const char *)"\p(Tear-off)");
- } else if (mePtr->imageString != NULL) {
- strcpy((char *)itemText, (const char *)"\p(Image)");
- } else if (mePtr->bitmap != None) {
- strcpy((char *)itemText, (const char *)"\p(Pixmap)");
- } else if (mePtr->label == NULL || mePtr->labelLength == 0) {
-
+ 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.
*/
-
- strcpy((char *)itemText, (const char *)"\p ");
+
+ Tcl_DStringAppend(dStringPtr, " ", -1);
} else {
- char *text = mePtr->label;
+ int length;
+ char *text = Tcl_GetStringFromObj(mePtr->labelPtr, &length);
+ char *dStringText;
int i;
-
- itemText[0] = 0;
- for (i = 1; (*text != '\0') && (i <= 230); i++, text++) {
+
+ for (i = 0; *text; text++, i++) {
if ((*text == '.')
&& (*(text + 1) != '\0') && (*(text + 1) == '.')
&& (*(text + 2) != '\0') && (*(text + 2) == '.')) {
- itemText[i] = 'É';
- text += 2;
- } else {
- itemText[i] = *text;
+ 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;
}
- itemText[0] += 1;
}
}
}
@@ -740,11 +751,11 @@ GetEntryText(
*
* We try the following special mac characters. If none of them
* are present, just use the check mark.
- * '' - Check mark character
- * '¥' - Bullet character
- * '' - Filled diamond
- * '×' - Hollow diamond
- * 'Ñ' = Long dash ("em dash")
+ * '' - 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:
@@ -762,23 +773,26 @@ FindMarkCharacter(
* for. */
{
char markChar;
- Tk_Font tkfont = (mePtr->tkfont == NULL) ? mePtr->menuPtr->tkfont
- : mePtr->tkfont;
+ Tk_Font tkfont;
+
+ tkfont = Tk_GetFontFromObj(mePtr->menuPtr->tkwin,
+ (mePtr->fontPtr == NULL) ? mePtr->menuPtr->fontPtr
+ : mePtr->fontPtr);
- if (!TkMacIsCharacterMissing(tkfont, '')) {
- markChar = '';
- } else if (!TkMacIsCharacterMissing(tkfont, '¥')) {
- markChar = '¥';
- } else if (!TkMacIsCharacterMissing(tkfont, '')) {
- markChar = '';
- } else if (!TkMacIsCharacterMissing(tkfont, '×')) {
- markChar = '×';
- } else if (!TkMacIsCharacterMissing(tkfont, 'Ñ')) {
- markChar = 'Ñ';
+ 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 = '-';
+ markChar = '-'; /* Short Dash */
} else {
- markChar = '';
+ markChar = '\022'; /* Check mark */
}
return markChar;
}
@@ -821,14 +835,13 @@ SetMenuIndicator(
if (mePtr->type == CASCADE_ENTRY) {
return;
}
-
- if (((mePtr->type == RADIO_BUTTON_ENTRY)
- || (mePtr->type == CHECK_BUTTON_ENTRY))
- && (mePtr->indicatorOn)
- && (mePtr->entryFlags & ENTRY_SELECTED)) {
- markChar = FindMarkCharacter(mePtr);
- } else {
- markChar = 0;
+
+ 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);
}
@@ -855,10 +868,12 @@ SetMenuIndicator(
static void
SetMenuTitle(
MenuHandle menuHdl, /* The menu we are setting the title of. */
- char *title) /* The C string to set the title to. */
+ 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;
@@ -895,7 +910,7 @@ SetMenuTitle(
*
* Results:
* Returns standard TCL result. If TCL_ERROR is returned, then
- * interp->result contains an error message.
+ * the interp's result contains an error message.
*
* Side effects:
* Configuration information get set for mePtr; old resources
@@ -935,7 +950,7 @@ TkpConfigureMenuEntry(
}
if (menuPtr->menuType == MENUBAR) {
- SetMenuTitle(childMenuHdl, mePtr->label);
+ SetMenuTitle(childMenuHdl, mePtr->labelPtr);
}
}
}
@@ -951,7 +966,9 @@ TkpConfigureMenuEntry(
if (0 == mePtr->accelLength) {
((EntryGeometry *)mePtr->platformEntryData)->accelTextStart = -1;
} else {
- char *accelString = mePtr->accel;
+ char *accelString = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ char *accel = accelString;
mePtr->entryFlags |= ~ENTRY_ACCEL_MASK;
while (1) {
@@ -997,7 +1014,7 @@ TkpConfigureMenuEntry(
}
((EntryGeometry *)mePtr->platformEntryData)->accelTextStart
- = ((long) accelString - (long) mePtr->accel);
+ = ((long) accelString - (long) accel);
}
if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
@@ -1044,11 +1061,14 @@ ReconfigureIndividualMenu(
TkMenuEntry *mePtr;
Str255 itemText;
int parentDisabled = 0;
-
+
for (mePtr = menuPtr->menuRefPtr->parentEntryPtr; mePtr != NULL;
mePtr = mePtr->nextCascadePtr) {
- if (strcmp(Tk_PathName(menuPtr->tkwin), mePtr->name) == 0) {
- if (mePtr->state == tkDisabledUid) {
+ 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;
@@ -1077,15 +1097,25 @@ ReconfigureIndividualMenu(
if (mePtr->type == SEPARATOR_ENTRY) {
AppendMenu(macMenuHdl, SEPARATOR_TEXT);
} else {
- GetEntryText(mePtr, itemText);
+ 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 == tkDisabledUid)) {
+ if (parentDisabled || (mePtr->state == ENTRY_DISABLED)) {
DisableItem(macMenuHdl, base + index);
} else {
EnableItem(macMenuHdl, base + index);
@@ -1099,8 +1129,8 @@ ReconfigureIndividualMenu(
if ((mePtr->type == CHECK_BUTTON_ENTRY)
|| (mePtr->type == RADIO_BUTTON_ENTRY)) {
CheckItem(macMenuHdl, base + index, (mePtr->entryFlags
- & ENTRY_SELECTED) && (mePtr->indicatorOn));
- if ((mePtr->indicatorOn)
+ & ENTRY_SELECTED) && mePtr->indicatorOn);
+ if (mePtr->indicatorOn
&& (mePtr->entryFlags & ENTRY_SELECTED)) {
SetItemMark(macMenuHdl, base + index,
FindMarkCharacter(mePtr));
@@ -1145,11 +1175,11 @@ ReconfigureIndividualMenu(
}
if ((mePtr->type != CASCADE_ENTRY)
- && (ENTRY_COMMAND_ACCEL
- == (mePtr->entryFlags & ENTRY_ACCEL_MASK))) {
- SetItemCmd(macMenuHdl, index, mePtr
- ->accel[((EntryGeometry *)mePtr->platformEntryData)
- ->accelTextStart]);
+ && (ENTRY_COMMAND_ACCEL
+ == (mePtr->entryFlags & ENTRY_ACCEL_MASK))) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ SetItemCmd(macMenuHdl, base + index, accel[((EntryGeometry *)
+ mePtr->platformEntryData)->accelTextStart]);
}
}
}
@@ -1442,7 +1472,7 @@ TkpMenuNewEntry(
*----------------------------------------------------------------------
*/
-EXTERN void
+void
Tk_MacTurnOffMenus()
{
gNoTkMenus = 1;
@@ -1591,9 +1621,9 @@ DrawMenuBarWhenIdle(
if (menuBarPtr == NULL) {
SetDefaultMenubar();
- } else {
- if (menuBarPtr->tearOff != menuPtr->tearOff) {
- if (menuBarPtr->tearOff) {
+ } else {
+ if (menuBarPtr->tearoff != menuPtr->tearoff) {
+ if (menuBarPtr->tearoff) {
appleIndex = (-1 == appleIndex) ? appleIndex
: appleIndex + 1;
helpIndex = (-1 == helpIndex) ? helpIndex
@@ -1641,7 +1671,7 @@ DrawMenuBarWhenIdle(
for (i = 0; i < menuBarPtr->numEntries; i++) {
if (i == appleIndex) {
- if (menuBarPtr->entries[i]->state == tkDisabledUid) {
+ if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) {
DisableItem(((MacMenu *) menuBarPtr->entries[i]
->childMenuRefPtr->menuPtr
->platformData)->menuHdl,
@@ -1684,7 +1714,7 @@ DrawMenuBarWhenIdle(
DeleteMenu((*macMenuHdl)->menuID);
InsertMenu(macMenuHdl, 0);
RecursivelyInsertMenu(cascadeMenuPtr);
- if (menuBarPtr->entries[i]->state == tkDisabledUid) {
+ if (menuBarPtr->entries[i]->state == ENTRY_DISABLED) {
DisableItem(((MacMenu *) menuBarPtr->entries[i]
->childMenuRefPtr->menuPtr
->platformData)->menuHdl,
@@ -1739,7 +1769,8 @@ RecursivelyInsertMenu(
&& (menuPtr->entries[i]->childMenuRefPtr->menuPtr
!= NULL)) {
cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr;
- macMenuHdl = ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
+ macMenuHdl =
+ ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
InsertMenu(macMenuHdl, -1);
RecursivelyInsertMenu(cascadeMenuPtr);
}
@@ -1780,7 +1811,8 @@ RecursivelyDeleteMenu(
&& (menuPtr->entries[i]->childMenuRefPtr->menuPtr
!= NULL)) {
cascadeMenuPtr = menuPtr->entries[i]->childMenuRefPtr->menuPtr;
- macMenuHdl = ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
+ macMenuHdl =
+ ((MacMenu *) cascadeMenuPtr->platformData)->menuHdl;
DeleteMenu((*macMenuHdl)->menuID);
RecursivelyInsertMenu(cascadeMenuPtr);
}
@@ -1849,8 +1881,15 @@ TkpSetMainMenubar(
{
TkWindow *winPtr = (TkWindow *) tkwin;
WindowRef macWindowPtr = (WindowRef) TkMacGetDrawablePort(winPtr->window);
+ WindowRef frontNonFloating;
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontNonFloating = FrontNonFloatingWindow();
+ } else {
+ frontNonFloating = FrontWindow();
+ }
- if ((macWindowPtr == NULL) || (macWindowPtr != FrontWindow())) {
+ if ((macWindowPtr == NULL) || (macWindowPtr != frontNonFloating)) {
return;
}
@@ -1890,7 +1929,8 @@ TkpSetMainMenubar(
}
}
if (listPtr != NULL) {
- menuName = Tk_PathName(listPtr->menuPtr->masterMenuPtr->tkwin);
+ menuName = Tk_PathName(listPtr->menuPtr->masterMenuPtr
+ ->tkwin);
break;
}
}
@@ -2092,15 +2132,15 @@ GetMenuAccelGeometry (
} 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, mePtr->accel,
- mePtr->accelLength);
+ *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, mePtr->accel,
- mePtr->accelLength);
+ int width = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
*textWidthPtr = emWidth;
if (width < emWidth) {
*modWidthPtr = 0;
@@ -2125,7 +2165,7 @@ GetMenuAccelGeometry (
if (1 == (mePtr->accelLength - length)) {
*textWidthPtr = emWidth;
} else {
- *textWidthPtr += Tk_TextWidth(tkfont, mePtr->accel
+ *textWidthPtr += Tk_TextWidth(tkfont, accel
+ length, mePtr->accelLength - length);
}
}
@@ -2235,21 +2275,27 @@ DrawMenuEntryIndicator(
int width, /* width of entry */
int height) /* height of entry */
{
- if (((mePtr->type == CHECK_BUTTON_ENTRY) ||
- (mePtr->type == RADIO_BUTTON_ENTRY))
- && (mePtr->indicatorOn)
- && (mePtr->entryFlags & ENTRY_SELECTED)) {
- int baseline;
- short markShort;
- char markChar;
+ 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) {
- markChar = (char) markShort;
- Tk_DrawChars(menuPtr->display, d, gc, tkfont, &markChar, 1,
- x + 2, baseline);
+ 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);
+ }
}
}
}
@@ -2343,11 +2389,11 @@ DrawSICN(
GetForeColor(&origForeColor);
GetBackColor(&origBackColor);
- if (TkSetMacColor(gc->foreground, &foreColor) == true) {
+ if (TkSetMacColor(gc->foreground, &foreColor)) {
RGBForeColor(&foreColor);
}
- if (TkSetMacColor(gc->background, &backColor) == true) {
+ if (TkSetMacColor(gc->background, &backColor)) {
RGBBackColor(&backColor);
}
@@ -2401,6 +2447,10 @@ DrawMenuEntryAccelerator(
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
@@ -2414,7 +2464,7 @@ DrawMenuEntryAccelerator(
Tk_Window tkwin = menuPtr->tkwin;
if (mePtr->type == CASCADE_ENTRY) {
- points[0].x = width - menuPtr->activeBorderWidth
+ 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;
@@ -2429,11 +2479,14 @@ DrawMenuEntryAccelerator(
} 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, mePtr->accel,
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
mePtr->accelLength, leftEdge, baseline);
} else {
EntryGeometry *geometryPtr =
@@ -2445,7 +2498,7 @@ DrawMenuEntryAccelerator(
leftEdge -= geometryPtr->modifierWidth;
}
- Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel
+ geometryPtr->accelTextStart, length, leftEdge, baseline);
if (mePtr->entryFlags & ENTRY_COMMAND_ACCEL) {
@@ -2574,7 +2627,7 @@ MenuDefProc(
TkMenuEntry *parentEntryPtr;
Tcl_HashEntry *commandEntryPtr;
GrafPtr windowMgrPort;
- Tk_Font tkfont;
+ Tk_Font tkfont, menuFont;
Tk_FontMetrics fontMetrics, entryMetrics;
Tk_FontMetrics *fmPtr;
TkMenuEntry *mePtr;
@@ -2708,7 +2761,8 @@ MenuDefProc(
* that are lower than the bottom.
*/
- Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);
+ 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
@@ -2719,11 +2773,11 @@ MenuDefProc(
continue;
}
/* ClipRect(&menuClipRect); */
- if (mePtr->tkfont == NULL) {
+ if (mePtr->fontPtr == NULL) {
fmPtr = &fontMetrics;
- tkfont = menuPtr->tkfont;
+ tkfont = menuFont;
} else {
- tkfont = mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -2758,16 +2812,16 @@ MenuDefProc(
GetBackColor(&origBackColor);
if (TkSetMacColor(menuPtr->textGC->foreground,
- &foreColor) == true) {
- if (!TkMacHaveAppearance()) {
+ &foreColor)) {
+ /* if (!TkMacHaveAppearance()) { */
RGBForeColor(&foreColor);
- }
+ /* } */
}
if (TkSetMacColor(menuPtr->textGC->background,
- &backColor) == true) {
- if (!TkMacHaveAppearance()) {
+ &backColor)) {
+ /* if (!TkMacHaveAppearance()) { */
RGBBackColor(&backColor);
- }
+ /* } */
}
/*
@@ -2792,7 +2846,7 @@ MenuDefProc(
+ menuPtr->entries[i]->height;
if (PtInRect(hitPt, &itemRect)) {
if ((mePtr->type == SEPARATOR_ENTRY)
- || (mePtr->state == tkDisabledUid)) {
+ || (mePtr->state == ENTRY_DISABLED)) {
newItem = -1;
} else {
TkMenuEntry *cascadeEntryPtr;
@@ -2803,10 +2857,13 @@ MenuDefProc(
cascadeEntryPtr != NULL;
cascadeEntryPtr
= cascadeEntryPtr->nextCascadePtr) {
- if (strcmp(cascadeEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) == 0) {
- if (cascadeEntryPtr->state
- == tkDisabledUid) {
+ char *name;
+
+ name = Tcl_GetStringFromObj(
+ cascadeEntryPtr->namePtr, NULL);
+ if (strcmp(name, Tk_PathName(menuPtr->tkwin))
+ == 0) {
+ if (cascadeEntryPtr->state == ENTRY_DISABLED) {
parentDisabled = 1;
}
break;
@@ -2860,7 +2917,13 @@ MenuDefProc(
if (oldItem != newItem) {
if (oldItem >= 0) {
mePtr = menuPtr->entries[oldItem];
- tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont;
+ 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,
@@ -2874,10 +2937,16 @@ MenuDefProc(
int oldActiveItem = menuPtr->active;
mePtr = menuPtr->entries[newItem];
- if (mePtr->state != tkDisabledUid) {
+ if (mePtr->state != ENTRY_DISABLED) {
TkActivateMenuEntry(menuPtr, newItem);
}
- tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont;
+ 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,
@@ -2892,7 +2961,7 @@ MenuDefProc(
MenuSelectEvent(menuPtr);
Tcl_ServiceAll();
tkUseMenuCascadeRgn = 0;
- if (mePtr->state != tkDisabledUid) {
+ if (mePtr->state != ENTRY_DISABLED) {
TkActivateMenuEntry(menuPtr, -1);
}
*whichItem = newItem + 1;
@@ -2905,7 +2974,8 @@ MenuDefProc(
- globalsPtr->menuBottom) {
scrollAmt = menuRectPtr->bottom - globalsPtr->menuBottom;
}
- if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt) < menuRectPtr->top)) {
+ if (!hasTopScroll && ((globalsPtr->menuTop + scrollAmt)
+ < menuRectPtr->top)) {
SetRect(&updateRect, menuRectPtr->left,
globalsPtr->menuTop, menuRectPtr->right,
globalsPtr->menuTop + SICN_HEIGHT);
@@ -2937,6 +3007,7 @@ MenuDefProc(
}
}
if (scrollDirection != DONT_SCROLL) {
+ Tk_Font menuFont;
RgnHandle updateRgn = NewRgn();
ScrollRect(&menuClipRect, 0, scrollAmt, updateRgn);
updateRect = (*updateRgn)->rgnBBox;
@@ -2951,7 +3022,8 @@ MenuDefProc(
}
ClipRect(&updateRect);
EraseRect(&updateRect);
- Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);
+ 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
@@ -2961,11 +3033,12 @@ MenuDefProc(
> updateRect.bottom) {
continue;
}
- if (mePtr->tkfont == NULL) {
+ if (mePtr->fontPtr == NULL) {
fmPtr = &fontMetrics;
- tkfont = menuPtr->tkfont;
+ tkfont = menuFont;
} else {
- tkfont = mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin,
+ mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -2995,18 +3068,23 @@ MenuDefProc(
menuRefPtr = TkFindMenuReferences(menuPtr->interp,
Tk_PathName(menuPtr->tkwin));
if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr != NULL)) {
+ char *name;
for (parentEntryPtr = menuRefPtr->parentEntryPtr;
- strcmp(parentEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) == 0;
- parentEntryPtr = parentEntryPtr->nextCascadePtr) {
+ 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);
+ parentEntryPtr->index);
}
}
- if (menuPtr->tearOff) {
+ if (menuPtr->tearoff) {
scratchRect = *menuRectPtr;
if (tearoffStruct.menuPtr == NULL) {
scratchRect.top -= 10;
@@ -3089,12 +3167,29 @@ MenuDefProc(
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 + menuPtr->totalHeight > maxMenuHeight) {
- menuRectPtr->top -= maxMenuHeight - menuPtr->totalHeight;
+
+ 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;
@@ -3107,6 +3202,8 @@ MenuDefProc(
} else {
*whichItem = menuRectPtr->top;
}
+ globalsPtr->menuTop = *whichItem;
+ globalsPtr->menuBottom = menuRectPtr->bottom;
break;
}
}
@@ -3157,9 +3254,9 @@ AppearanceEntryDrawWrapper(
itemRect.bottom = itemRect.top + height;
itemRect.right = itemRect.left + width;
- if (mePtr->state == tkActiveUid) {
+ if (mePtr->state == ENTRY_ACTIVE) {
theState = kThemeMenuSelected;
- } else if (mePtr->state == tkDisabledUid) {
+ } else if (mePtr->state == ENTRY_DISABLED) {
theState = kThemeMenuDisabled;
} else {
theState = kThemeMenuActive;
@@ -3235,7 +3332,7 @@ TkMacHandleTearoffMenu(void)
{
if (tearoffStruct.menuPtr != NULL) {
Tcl_DString tearoffCmdStr;
- char intString[20];
+ char intString[TCL_INTEGER_SPACE];
short windowPart;
WindowRef whichWindow;
@@ -3345,6 +3442,7 @@ DrawTearoffEntry(
{
XPoint points[2];
int margin, segmentWidth, maxX;
+ Tk_3DBorder border;
if ((menuPtr->menuType != MASTER_MENU) || (FixMDEF() != NULL)) {
return;
@@ -3356,13 +3454,14 @@ DrawTearoffEntry(
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, menuPtr->border, points, 2, 1,
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
TK_RELIEF_RAISED);
points[0].x += 2*segmentWidth;
}
@@ -3473,12 +3572,13 @@ TkpDrawMenuEntry(
* arrow for cascade items. Only applies
* to Windows. */
{
- GC gc, indicatorGC;
+ GC gc;
TkMenu *menuPtr = mePtr->menuPtr;
+ int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
+ GC indicatorGC;
Tk_3DBorder bgBorder, activeBorder;
- CONST Tk_FontMetrics *fmPtr;
+ const Tk_FontMetrics *fmPtr;
Tk_FontMetrics entryMetrics;
- int padY = (menuPtr->menuType == MENUBAR) ? 3 : 0;
int adjustedY = y + padY;
int adjustedHeight = height - 2 * padY;
@@ -3488,16 +3588,10 @@ TkpDrawMenuEntry(
* ourselves not to change whatever color the appearance manager has set.
*/
- if ((mePtr->state == tkActiveUid)
- && !strictMotif) {
+ if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {
gc = mePtr->activeGC;
if (gc == NULL) {
- if ((TkMacHaveAppearance() > 1) && (menuPtr->menuType != TEAROFF_MENU)) {
- SetThemeTextColor(kThemeSelectedMenuItemTextColor,32,true);
- gc = appearanceGC;
- } else {
gc = menuPtr->activeGC;
- }
}
} else {
TkMenuEntry *cascadeEntryPtr;
@@ -3506,35 +3600,27 @@ TkpDrawMenuEntry(
for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
cascadeEntryPtr != NULL;
cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
- if (strcmp(cascadeEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) == 0) {
- if (cascadeEntryPtr->state == tkDisabledUid) {
+ 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 == tkDisabledUid)))
- && (menuPtr->disabledFg != NULL)) {
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
gc = mePtr->disabledGC;
if (gc == NULL) {
- if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) {
- SetThemeTextColor(kThemeDisabledMenuItemTextColor,32,true);
- gc = appearanceGC;
- } else {
gc = menuPtr->disabledGC;
}
- }
} else {
gc = mePtr->textGC;
if (gc == NULL) {
- if ((TkMacHaveAppearance() > 1) && (mePtr->bitmap == NULL)) {
- SetThemeTextColor(kThemeActiveMenuItemTextColor,32,true);
- gc = appearanceGC;
- } else {
- gc = menuPtr->textGC;
- }
+ gc = menuPtr->textGC;
}
}
}
@@ -3543,24 +3629,22 @@ TkpDrawMenuEntry(
if (indicatorGC == NULL) {
indicatorGC = menuPtr->indicatorGC;
}
-
- bgBorder = mePtr->border;
- if (bgBorder == NULL) {
- bgBorder = menuPtr->border;
- }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL)
+ ? menuPtr->borderPtr : mePtr->borderPtr);
if (strictMotif) {
activeBorder = bgBorder;
} else {
- activeBorder = mePtr->activeBorder;
- if (activeBorder == NULL) {
- activeBorder = menuPtr->activeBorder;
- }
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL)
+ ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
}
- if (mePtr->tkfont == NULL) {
+ if (mePtr->fontPtr == NULL) {
fmPtr = menuMetricsPtr;
} else {
- tkfont = mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -3616,13 +3700,13 @@ void
TkpComputeStandardMenuGeometry(
TkMenu *menuPtr) /* Structure describing menu. */
{
- Tk_Font tkfont;
+ 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;
+ int entryWidth, maxIndicatorSpace, borderWidth, activeBorderWidth;
TkMenuEntry *mePtr, *columnEntryPtr;
EntryGeometry *geometryPtr;
@@ -3630,7 +3714,11 @@ TkpComputeStandardMenuGeometry(
return;
}
- x = y = menuPtr->borderWidth;
+ 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;
@@ -3648,15 +3736,16 @@ TkpComputeStandardMenuGeometry(
* give all of the geometry/drawing the entry's font and metrics.
*/
- Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
+ menuFont = Tk_GetFontFromObj(menuPtr->tkwin, menuPtr->fontPtr);
+ Tk_GetFontMetrics(menuFont, &menuMetrics);
for (i = 0; i < menuPtr->numEntries; i++) {
mePtr = menuPtr->entries[i];
- tkfont = mePtr->tkfont;
- if (tkfont == NULL) {
- tkfont = menuPtr->tkfont;
- fmPtr = &menuMetrics;
+ if (mePtr->fontPtr == NULL) {
+ tkfont = menuFont;
+ fmPtr = &menuMetrics;
} else {
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -3672,7 +3761,7 @@ TkpComputeStandardMenuGeometry(
columnEntryPtr->indicatorSpace = maxIndicatorSpace;
columnEntryPtr->width = maxIndicatorSpace + maxWidth
- + 2 * menuPtr->activeBorderWidth;
+ + 2 * activeBorderWidth;
geometryPtr->accelTextWidth = maxAccelTextWidth;
geometryPtr->modifierWidth = maxModifierWidth;
columnEntryPtr->x = x;
@@ -3687,13 +3776,13 @@ TkpComputeStandardMenuGeometry(
geometryPtr->nonAccelMargin = 0;
}
}
- x += maxIndicatorSpace + maxWidth + 2 * menuPtr->borderWidth;
+ x += maxIndicatorSpace + maxWidth + 2 * borderWidth;
windowWidth = x;
maxWidth = maxIndicatorSpace = maxAccelTextWidth = 0;
maxModifierWidth = maxNonAccelMargin = maxEntryWithAccelWidth = 0;
maxEntryWithoutAccelWidth = 0;
lastColumnBreak = i;
- y = menuPtr->borderWidth;
+ y = borderWidth;
}
if (mePtr->type == SEPARATOR_ENTRY) {
@@ -3705,7 +3794,6 @@ TkpComputeStandardMenuGeometry(
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
@@ -3725,8 +3813,8 @@ TkpComputeStandardMenuGeometry(
&modifierWidth, &accelWidth, &height);
nonAccelMargin = 0;
} else if (mePtr->accelLength == 0) {
- nonAccelMargin = mePtr->hideMargin ? 0
- : Tk_TextWidth(tkfont, "m", 1);
+ nonAccelMargin = mePtr->hideMargin ? 0
+ : Tk_TextWidth(tkfont, "m", 1);
accelWidth = modifierWidth = 0;
} else {
labelWidth += Tk_TextWidth(tkfont, "m", 1);
@@ -3778,10 +3866,10 @@ TkpComputeStandardMenuGeometry(
}
}
- mePtr->height += 2 * menuPtr->activeBorderWidth;
+ mePtr->height += 2 * activeBorderWidth;
}
mePtr->y = y;
- y += menuPtr->entries[i]->height + menuPtr->borderWidth;
+ y += menuPtr->entries[i]->height + borderWidth;
if (y > windowHeight) {
windowHeight = y;
}
@@ -3793,7 +3881,7 @@ TkpComputeStandardMenuGeometry(
columnEntryPtr->indicatorSpace = maxIndicatorSpace;
columnEntryPtr->width = maxIndicatorSpace + maxWidth
- + 2 * menuPtr->activeBorderWidth;
+ + 2 * activeBorderWidth;
geometryPtr->accelTextWidth = maxAccelTextWidth;
geometryPtr->modifierWidth = maxModifierWidth;
columnEntryPtr->x = x;
@@ -3809,8 +3897,8 @@ TkpComputeStandardMenuGeometry(
}
}
windowWidth = x + maxIndicatorSpace + maxWidth
- + 2 * menuPtr->activeBorderWidth + menuPtr->borderWidth;
- windowHeight += menuPtr->borderWidth;
+ + 2 * activeBorderWidth + borderWidth;
+ windowHeight += borderWidth;
/*
* The X server doesn't like zero dimensions, so round up to at least
@@ -3879,30 +3967,43 @@ DrawMenuEntryLabel(
imageHeight, d, leftEdge,
(int) (y + (mePtr->height - imageHeight)/2));
}
- } else if (mePtr->bitmap != None) {
+ } else if (mePtr->bitmapPtr != NULL) {
int width, height;
-
+ Pixmap bitmap = Tk_GetBitmapFromObj(menuPtr->tkwin, mePtr->bitmapPtr);
Tk_SizeOfBitmap(menuPtr->display,
- mePtr->bitmap, &width, &height);
- XCopyPlane(menuPtr->display,
- mePtr->bitmap, d,
- gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
+ 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) {
- Str255 itemText;
+ Tcl_DString itemTextDString, convertedTextDString;
+
+ 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: */
- GetEntryText(mePtr, itemText);
- Tk_DrawChars(menuPtr->display, d, gc,
- tkfont, (char *) itemText + 1, itemText[0],
- leftEdge, baseline);
-/* TkpDrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
- width, height);*/
+ TkMacSetUpGraphicsPort(gc);
+ MoveTo((short) leftEdge, (short) baseline);
+ 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 == tkDisabledUid) {
- if (menuPtr->disabledFg == NULL) {
+ if (mePtr->state == ENTRY_DISABLED) {
+ if (menuPtr->disabledFgPtr == NULL) {
if (!TkMacHaveAppearance()) {
XFillRectangle(menuPtr->display, d, menuPtr->disabledGC, x, y,
(unsigned) width, (unsigned) height);
@@ -3950,9 +4051,10 @@ DrawMenuEntryBackground(
{
if (!TkMacHaveAppearance()
|| (menuPtr->menuType == TEAROFF_MENU)
- || ((mePtr->state == tkActiveUid) && (mePtr->activeBorder != NULL))
- || ((mePtr->state != tkActiveUid) && (mePtr->border != NULL))) {
- if (mePtr->state == tkActiveUid) {
+ || ((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,
@@ -3991,17 +4093,20 @@ GetMenuLabelGeometry(
if (mePtr->image != NULL) {
Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
- } else if (mePtr->bitmap != (Pixmap) NULL) {
- Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
+ } else 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->label != NULL) {
- Str255 itemText;
+ if (mePtr->labelPtr != NULL) {
+ Tcl_DString itemTextDString;
- GetEntryText(mePtr, itemText);
- *widthPtr = Tk_TextWidth(tkfont, (char *) itemText + 1,
- itemText[0]);
+ GetEntryText(mePtr, &itemTextDString);
+ *widthPtr = Tk_TextWidth(tkfont,
+ Tcl_DStringValue(&itemTextDString),
+ Tcl_DStringLength(&itemTextDString));
+ Tcl_DStringFree(&itemTextDString);
} else {
*widthPtr = 0;
}
@@ -4106,7 +4211,8 @@ RecursivelyClearActiveMenu(
*/
void
-InvalidateMDEFRgns(void) {
+InvalidateMDEFRgns(void)
+{
GDHandle saveDevice;
GWorldPtr saveWorld, destPort;
Point scratch;
@@ -4154,7 +4260,8 @@ InvalidateMDEFRgns(void) {
*/
void
-TkMacClearMenubarActive(void) {
+TkMacClearMenubarActive(void)
+{
TkMenuReferences *menuBarRefPtr;
if (currentMenuBarName != NULL) {
@@ -4262,7 +4369,7 @@ FixMDEF(void)
* None.
*
* Side effects:
- * Allcates a hash table.
+ * Allocates a hash table.
*
*----------------------------------------------------------------------
*/
@@ -4279,12 +4386,12 @@ TkpMenuInit(void)
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;
@@ -4292,11 +4399,78 @@ TkpMenuInit(void)
tmpColorPtr = TkpGetColor(NULL, "systemAppearanceColor");
tmpValues.foreground = tmpColorPtr->color.pixel;
tmpValues.background = tmpColorPtr->color.pixel;
- appearanceGC = XCreateGC(NULL, NULL, GCForeground | GCBackground, &tmpValues);
ckfree((char *) tmpColorPtr);
tkThemeMenuItemDrawingUPP = NewMenuItemDrawingProc(tkThemeMenuItemDrawingProc);
}
FixMDEF();
+ Tcl_ExternalToUtf(NULL, NULL, "\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/tk/mac/tkMacMenu.r b/tk/mac/tkMacMenu.r
index feb3a5f05ee..58434300343 100644
--- a/tk/mac/tkMacMenu.r
+++ b/tk/mac/tkMacMenu.r
@@ -45,3 +45,4 @@ resource 'SICN' (128, preload, locked) {
$"0FE0 1FF0 3FF8"
}
};
+
diff --git a/tk/mac/tkMacMenubutton.c b/tk/mac/tkMacMenubutton.c
index 6ba9f192edb..b7ffe5d2898 100644
--- a/tk/mac/tkMacMenubutton.c
+++ b/tk/mac/tkMacMenubutton.c
@@ -110,9 +110,10 @@ TkpDisplayMenuButton(
SetGWorld(destPort, NULL);
macDraw = (MacDrawable *) Tk_WindowId(tkwin);
- if ((mbPtr->state == tkDisabledUid) && (mbPtr->disabledFg != NULL)) {
+ if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
gc = mbPtr->disabledGC;
- } else if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {
+ } else if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
gc = mbPtr->activeTextGC;
} else {
gc = mbPtr->normalTextGC;
@@ -162,10 +163,10 @@ TkpDisplayMenuButton(
* foreground color, generate the stippled effect.
*/
- if ((mbPtr->state == tkDisabledUid)
- && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) {
- XFillRectangle(mbPtr->display, Tk_WindowId(tkwin), mbPtr->disabledGC,
- mbPtr->inset, mbPtr->inset,
+ 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));
}
@@ -221,19 +222,18 @@ TkpDisplayMenuButton(
LineTo(r.left + kShadowOffset, r.bottom);
}
- if (mbPtr->state == tkDisabledUid) {
- }
-
if (mbPtr->highlightWidth != 0) {
- GC gc;
+ GC fgGC, bgGC;
+ bgGC = Tk_GCForColor(mbPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
if (mbPtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(mbPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ fgGC = Tk_GCForColor(mbPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, mbPtr->highlightWidth,
+ Tk_WindowId(tkwin));
} else {
- gc = Tk_GCForColor(mbPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, mbPtr->highlightWidth,
+ Tk_WindowId(tkwin));
}
- Tk_DrawFocusHighlight(tkwin, gc, mbPtr->highlightWidth,
- Tk_WindowId(tkwin));
}
SetGWorld(saveWorld, saveDevice);
@@ -337,3 +337,4 @@ TkpComputeMenuButtonGeometry(mbPtr)
(int) (height + 2*mbPtr->inset));
Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset);
}
+
diff --git a/tk/mac/tkMacMenus.c b/tk/mac/tkMacMenus.c
index 7808ffa93be..2c38c8f1477 100644
--- a/tk/mac/tkMacMenus.c
+++ b/tk/mac/tkMacMenus.c
@@ -13,7 +13,7 @@
*/
#include "tcl.h"
-#include "tclMacInt.h"
+#include "tclMacInt.h" /* Needed for FSpLocationFromPath */
#include "tk.h"
#include "tkInt.h"
#include "tkMacInt.h"
@@ -80,6 +80,7 @@ TkMacHandleMenuSelect(
Str255 name;
Tk_Window tkwin;
Window window;
+ TkDisplay *dispPtr;
if (mResult == 0) {
TkMacHandleTearoffMenu();
@@ -119,8 +120,13 @@ TkMacHandleMenuSelect(
break;
case kCloseItem:
/* Send close event */
- window = TkMacGetXWindow(FrontWindow());
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ if (TkMacHaveAppearance() >= 0x110) {
+ window = TkMacGetXWindow(FrontNonFloatingWindow());
+ } else {
+ window = TkMacGetXWindow(FrontWindow());
+ }
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
TkGenWMDestroyEvent(tkwin);
break;
case kQuitItem:
@@ -251,9 +257,15 @@ GenerateEditEvent(
Point where;
Tk_Window tkwin;
Window window;
+ TkDisplay *dispPtr;
- window = TkMacGetXWindow(FrontWindow());
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ 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;
@@ -317,30 +329,29 @@ GenerateEditEvent(
static void
SourceDialog()
{
- StandardFileReply reply;
- OSType fileTypes[1];
- OSErr err;
- int length, result;
- Handle path;
+ int result;
+ char *path;
+ char openCmd[] = "tk_getOpenFile -filetypes {\
+ {{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}";
if (gInterp == NULL) {
return;
}
- fileTypes[0] = 'TEXT';
- StandardGetFile(NULL, 1, fileTypes, &reply);
- if (reply.sfGood == false) {
+ if (Tcl_Eval(gInterp, openCmd) != TCL_OK) {
return;
}
- err = FSpPathFromLocation(&reply.sfFile, &length, &path);
- if (err == noErr) {
- HLock(path);
- result = Tcl_EvalFile(gInterp, *path);
- HUnlock(path);
- DisposeHandle(path);
+ path = Tcl_GetStringResult(gInterp);
+
+ if (strlen(path) == 0) {
+ return;
}
+
+ result = Tcl_EvalFile(gInterp, path);
if (result == TCL_ERROR) {
Tcl_BackgroundError(gInterp);
}
}
+
+
diff --git a/tk/mac/tkMacPort.h b/tk/mac/tkMacPort.h
index b1895b236f4..739d311ec44 100644
--- a/tk/mac/tkMacPort.h
+++ b/tk/mac/tkMacPort.h
@@ -6,7 +6,6 @@
* #includes for system include files and a few other things.
*
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -49,6 +48,7 @@
#include <Xatom.h>
#include <Xfuncproto.h>
#include <Xutil.h>
+#include "tkIntXlibDecls.h"
/*
* Not all systems declare the errno variable in errno.h. so this
@@ -70,12 +70,17 @@ extern int errno;
* 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.
@@ -91,15 +96,15 @@ extern int strncasecmp _ANSI_ARGS_((CONST char *s1,
#define XVisualIDFromVisual(visual) (visual->visualid)
/*
- * The following functions are not used on the Mac, so we stub it out.
+ * 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 Tk_FreeXId(display,xid)
#define TkpSync(display)
/*
@@ -145,3 +150,5 @@ extern int strncasecmp _ANSI_ARGS_((CONST char *s1,
#define APPEARANCE_PIXEL 52
#endif /* _TKMACPORT */
+
+
diff --git a/tk/mac/tkMacProjects.sea.hqx b/tk/mac/tkMacProjects.sea.hqx
new file mode 100644
index 00000000000..56c4c86375e
--- /dev/null
+++ b/tk/mac/tkMacProjects.sea.hqx
@@ -0,0 +1,2952 @@
+(This file must be converted with BinHex 4.0)
+:"R4V,R0PB3""8&"-BA9cG#!!N!1@&3!"P3mV5&0dG@CQ5A3J+'-T-6Nj0bda16N
+i)%&XB@4ND@iJ8hPcG'9YFb`J5@jM,L`JD(4dF$S[,hH3!bjKE'&NC'PZFhPc,Q0
+[E5p6G(9QCNPd,`d+'J!&%!!!PK8!N!0b!!%!N!0brcJ0TD95CA0PFRCPC+@P!+@
+3"!%!!$)!3,3GFADeGBBE!*!0!P2P!*!$b!!+bj!!!!#963!$G'X!!&9d!%i!$!'
+!!Ed$i!#3!i%$"rrirr$$3!!!J!#3"k@3"!%!!$S!!,5Kk8#eGBB3!*!$FJ!!$"N
+!N!0b!!T4MJ!!Ge3!!!Vc!*!%$`"8Dep04%9',Xq!!!#A[%e08(*$9dP&!3#3$i!
+!N!G#`G5k3PH`5A9,6'dL5XCiri8jld(5Ui8@CKHM[(RT9G-i*ZpVPpC`6-pSFT9
+S)fkfeI'9F!eV%30Z'&M6f3Rck)k85U"j(Vh[@Z#c95Z+R-ZI&19I0[`'"5JH5NH
+,-rahGL%'ZK"V[60Rj8XkZZ!Hqd8L,-fKI+r``r`Akf8%B,SIkK+Pb%K&Hl4r'Ni
+3EaY!`C80H1LP(h4M&ZB4IA594@!KaFP'*+1@c49UZC[Slk,i2br@![rS5!Fcd*q
+k92Mi5H$JE5)qPfNKBN,YHVQpC[aPH[$,(U([rc@Ra50il"+[2RYKijP-QP6Y,YR
+SP*!!MA@3!%3XCqS!S[H5#C2S+$HC)PdC4+$G5J)p4D2-0,()Q)1QlcHc&#q(I9p
+G6[U0cHD52aN*!$K+lI,0lEHa"dF1&GL'Si5E3VGN$,MIpB@2hI5Gb!N[Uj0Ga$&
+!5F!F!Y0))(+,imKTQaYJbbdkM+TLkPRfYN+%dHEe`%krcUJ"TC*H[YmpdcKSLEh
+N1Z3$b*NE3!+!e)c00N)2qD4NYXk"[`mhC!cm`$SQeeM1Z,i1KP-aeJI'Akk*AS!
+%E@kjYC!!%*TGEcZ02b[Af+,AjNHZ24a$,V+ZX*`P*'i!*1a-LqGKaY[`$h!DB"q
+4@+%'FL+#MpQa`aY'B`1&-'l4K[35#&C1F#mCJhRFqUB!e9BL1IcQ&i[cT)f5Qb(
+I!(Fj5bmXXcbHaSEp@lK`5$@-G4rZFl!8Rf1D0qU$3IUA6Rr&6A566jJU5%p2a@q
+6P@T8L`Q'j"$GEd4mE1&!)rekPQDa!dDfbhbUm5Tm9aZNdN(l-AeNZY8+N!!)l@Q
+EA,")Xr$NAe9S,*!!D"jR*VCY4HL1P!Qq(N3S5LqET9I82+RmcC)f[EEF"[6MaZD
+5(meqp90DkM2SkTi(Y*CEGjYLrXPjBK05Q"dD"*5%GpBIMLkm*+M[a)e%8ZPMCPk
+$Ykhd(2$+&4&d`0MHGB`cB#N6N4iJ+SMf*+[FVZ&V6V5h2QIhZcNc0BDDHH+&(4E
+iSJqq-V0KieMDTTKSGKa6P,D4,lD,M[f3!")0Rh"kb(UbB`Cb--33c#U,k4AqX[p
+f1N-B[0kBH)%CBlV3XCQQiY*Br2`l'U"8e1rXf4,5+Zmm-+6,8VN5#XeH44QPKaR
+'p`0JH5%#D5jE(G0QSd%N8VfXLA+8V5T$Bq$9H(#Xc`-G6RV9Q"cTp5kBNT8Gi"f
+kF1h[8kmE%c5["l+"dRGaYpqI$d,!%!'PMEJC'L949A04arcX@q0UcVNIV4KhffM
+iN!$PFdK0[,Dd9p3C554PAC8-h0PH`,"b,)U@q'KH65mE`YY`1GfL"Ie[UR2&DkJ
+aLM,d-UE2mkEmQr5K0ZiG"h"X,+U"qGlr+&G+3fYP1Z28CT!!k4c`R')AVAXIX%C
+UkYjZ`q#62'5[&lT'f3&`ZR"Xrp)-1$,AI23Fra#I#jAcG[h+b(B51kbc(%)ep9U
+fV"NLA!XC8MrYc`EH3!YJ(XG$G3`-$J9qeFhI2hNpNeQAL&iNlVl#qQG#jmL+&8Z
+l+!hS[%jH2Hfmr[lM8H"5$p39D+8q$*0DL%N)AVFRKLS@Deh+aA$Y!N[3PHjY"Yc
+KEM@CaB65ei%J-+0Be*3CrF"ef5B1Dq&3GjNJ91"c(*Q&VQKhBZmXbYc2Ekcd%8R
+""iJ`!bQS+BY(-a#R)lDi"$[0J5*9&`Y"r%8Tk!1bhjJNBT0G+aVN5FdD41$E(&"
+0%j%62,EhSj1PhL[H*GT(lkl4K2bRXaSD52lLB!*KQRYb&8LIPhr8LD*NNCMVff6
+QV2hpmK9G&Q6F(1&`!1c%"-AR@ZBp%GBLaDNf#F5`lfrpb'8IbB'pA'ekFY9Q#R*
+'-19[+j@6JIm$96SaHadXVfb(!6EjA+Lk'aL%NkXCS5dS&IPBh3T2Q!fU#Ea13Ni
+*HHd5NDJR`1)ep9h)d!VcpD5[aiT-0#@F4IS6M1mf)X4BYMY"YSBI5d+`aS9#EdT
+lYmkL*2L2,!RkG)9F`ELJP#$R%5D6*h12H(G4RmL-[)4T$$$AmIe&jSX-5kV`6p'
+03ddPDZE[TheIlGdP&p,E1Rr#fB9Cd%HmDCTT'(@-f9[@81RM0%q3!&"+jHkJ2IP
+Z++-*SI+3!$r)5Nf@kGA+!lVmlA,#'r&d980i9245m9e+R!*UT$k6$*!!T5!S"re
+3JbmlId"l2mINjhFY)2+h)em$TU#Gd3S1F`mMF[%LH0GQci['U3R8E*5"Z3HX*8X
+FR!&(e`LJU@99DE*PU,I[+#Xi'P11[LeaCLQKPhmUF"Tkp+C6EbeUH+XkNa*IlcB
+IY$G+U5#L%aYafJBEZp8Yf6b#J9V`JjXX+@SMh!H,!-)Ac-'&&1-HZ3CM!mS[6Y1
+A!Xjj@Q"%)I[G'Dk'lmrpD%jjr)j@5KJ"6N!a)cQLYr9Qb6Hdh)YYSjbal!j`21d
+CfS85,d'l0)Kc,mI346(+mUmh-`l2N!#'JP!Xh+q-E[[5qpbKHaS!cm3NF%iQZCQ
+dNajdF&N-&KVV*M6j156C(LE$j$i%j1crl1+%TFh5cJ!'N!$!qH)dH#qhICRH0G8
+9Tk2[X09`DDfV)Ke8UL0TKHLjS"([)l9+&fjq!!'4ccNU@PD2F9H@N!!8cTJJ)Nh
+&ffC8#jKT&iDRa#`'"[fRUTbriPqe5pS#Xi*`,0DCp*aDGQ`[ea2'c4!F%$1M6S[
+fci"-GN**(lD$*4,$f&a%1@0TZ8`F6U`!D"!6,99iTA`Q'!q)N!"UEJX[9HQZa@i
+j3k-Ebp#(56+Yb4q6dL35)6d&kGi1(Nl6M&9H6G4@Cl&jkXL(42bpH#eL+!mUa6Z
+R%0qrJ8PpPjN00KVabJ*[#E4AEdTf2'8Grme"GCqq+ViC*3pPh`EH'2Hk-MQ(AT`
+TB+MFqF!%Fb2G`lb@+LG%-$6L$4BK*mJUdM+3!*a8"'8Gdh&+iHRp5BGR0h5I-#X
+qBr6$G#N2PAZbZR&)FT0(`cFCbE%#SNrjp"X1'+#+6V3L!T!!G(X(I3-URKjhCe-
+K4BUc6B0ll@q)J+N$DlmT4[Gk+eUahViU820c@10-JF5Af!qJUIUN`)*FZBcPb6C
+2QKck$`,0*%lIef&M2U@,C5pI,Y%2,lb,,1Ca(+UM!)pEQA889j)6-b'SNMLB`#N
+9dLHFG1AZEP$-"EIIfMiRbC4SkYklD@Sf+&M-U'`J"F(H!C&YXr*lmGQF'(lT(pN
+CCYYLNG`64N#m!m*+rQDZ,TkXj+++q(SJlJjm"c"HY0`jZ[U&S4XL%46bDmMlM,$
+pj[eaM)&"HqN&MZa@C999AlKbBL-cA$dlbE++R$idhQd51T+XF44GM#cN9XiQ2U%
+FYAJXZH@9qL)i%R9+H"Gl6Sj2FZPmZjA#C"1LU9Khc)V45@3bA!*i33%`c%0ea2L
+'(L5CCd+8'Sd2*hbk,'lqm@XhhadXF$D$RVXHRpG80IP2X6qIj8)+DmY0qZ-1*36
+L1f,mlr%EG*rl9mk[ID$+-k6q8cc0AXkMKY'$"cVY#[M#!l1Yrbb(+pkcP*98F'6
+f`,J&#kNS")VXGdmXZilK+B&9FXZ6,0NpFjHC4iUHLG8bhK($Z@GT8M(CqVlRN9i
+H!hlap03M0RX8B*Q4&NHYM#3J8VrZ#Y)fTK6HJTcpb&r`bPKrbmY31*d(N8"$G(Y
+EDZ!hMLeP2@TF+2T1fZi$r!1JSq$89H22rq#"f4i*Ue2mrY$ipRf("pEEQ%j-CZ4
+hqDmYJ&peSG84rRi3H0UFNe&f`&a8k1%KSqB)Mpc*GiZA$lS"A!#PN!3"!!!q!!#
+dSHR'YA@'#!#3!mJ!!&0F!*!$FJ!16bX!"8VK!!"'i3#3"!m!9'Y-D@*bBA*TCA-
+Zci!!!*Hm68e3FN0A588"!*!2J!#3"d,"e2Sc!8A#-I&2&UGJmPKbdYp#28jJISH
+breV!QBGTTAK'iDkH3)00DM+kHYbYJYZ95@U`@TJS-YI"c[+bT[#+LE0XJr4eU2L
+4R(RDHh[p"'UG*V`!Hq(-qahId9E5'Kr9mrKmNmU'[G*qU1CNM*GMM`lD#)MR2-@
+N,ARd,1CH6VEa"[lBT4QYk$hkjk9"Qb&jIT!!5bpZ1%[Q4k06EM@!iG,TL8BF,p&
+j4"iI'HU$Z3d&Kca+MT8#6@+3!0V5@KpFDqZR,$`(c!@bpXci&A[QLIh$+32-DD`
+8VLNAr9$*0DU,A*'e%4F'G@r9CP0rf#Zp"pUZ`j['!qP8Bkp6mjER-DL+-hGXRR%
+YKP#P'2EcABq1+TK+K)X0$)6lRDpG,GHJTD&0ZcV#JTVGE#EJJ[2L8563Epd$AM!
+pHJNSR"*RmC1IQG&f29+B6KMJXTIlPT5pEaafRaQT)8fre-HZB',pTa'F,#V1a9R
+9iTSq0`3KIT&DCQ)%j@eYKHE9a@9A4jB`[E#)I2NH&%rEjmeli4K@acm%!jQ,(0l
+(0!2LFmXiCNPlP-TqR$,T1MrU88qEYr9)ADebfKZ&j8IGUQ,G+2@e'`acLkBR&Y!
+"YXe["NhDfZmh4bPKX*!!8U'8!9)VqH@#T`PDUSrpZ",Um"Nb5JISGZ+LLiqr,+b
+(0rHQYa&A!LUij80R1,GmH8QcfN$Ka[PJ0"UATR)XNUid5V92PNaEPGQ5RdL)9XS
+*fMh(FI3IdRKPT3dYF`akAL@UQrc1V@AjS@r(r,k3!10cTj8edpACreDdkK6lK2)
+K#jZ1BPiTf4H0U21e+IZXTmiMeM@cNT8+ca`*2rfJC5'S'"1,1JRf,Dk@EGI)Xb4
+k%VYLQ&)mF"b9CNUDBXh8NEr[#Gb"h9j#`"apS@,qhX(b502'L[p+DJeJcS56NLh
+%8e`!Ar#0DLQNG$CkR"da,3,1!6*BlP!I8`!HGk9,bSGf&*%%cQ)*,em-4qMeV*!
+!0Se!%9IST'l@!b-+H`h0Mi[`kKe4apUl-%0r-*aKEN'V!p5U!6PpPHGEei)SjVf
+"(Bki0aVcCb8fmUZF0L5a4UX-f*ULS#XIJmMXH3rrB4K,G%BjPBT0f8)mmHTZ!Zb
+UN!#PV`JHkqk+jS$XcU52Q05J4e@HbI@-cS&%dMDk1XZ0C!B"h@P"Vd@KfEZ,C%R
+G'T!!J)Nq@FJC6lD#c+!K[eDiIBN"+Lm0-JTm4Vl"1STT&pYfM-SAUL``mK%i+kI
+dXV4U[*8['irqR0-`GLeS38&iHc60G'2ha6`9hr`F24KCb'dcB[+0G"h&-E,3Lp3
+YVpP3ADhd6UIVKV-1YbP&VYA9eL-'#K-2T$Y'6MU3!!c!HKQ[bAe"cL+$ec5QjT-
+dqkmKGa2",-Q@1FbT9(4@%1`5c(8`IQ2U2(@m**(QZ2#(0`ch2fS`R3Y%jM`#4NT
+VS!2rE`C4iPMG5CZdRe2$)f8rbS)(INVj$S1j&i-[FUhB(%&L'AX&685CLe5U9+T
+6pHjpEND8i*pb(G'3!)ShiL6!#F6+JX[ZJdCrJqBLcIUpei#`KLXD)$PGF+,Yrjr
+&PIbYRpp6rC6R*Ll)edqF-&T0qFTNk'D3!!9E#RpReRf0`0[I`Giq!bLQRaYlc%E
+f-qGfLpi96jJ"'QTH!A@T0MLX-SrZ3R,kX-!Sb01,`4,EZFXR,@di9mE$Kd``Sh3
+4"kk$VpV'krAA,k0&0"TpBeZPj8"cR-@4B1TqR#Ir)GJ(a%KL&'5N`#,MdT1$aMY
+9#kPLSM4l"-'Ia@E4[YPdC5Q5&2C`DQHXY![Pc!R[X-"[XZ-jpKf,m0Gb(#p3,AD
+d2A!4Yb8+ZQDbjSB$0Z#2V'9`+&m[Z!@Qma#q+rQe!c49'!),U8ck2P*krA'm)rA
+iSKbHPp8,J3hidRp6h$0([CBV9Fr%q$2cqR@aQV5fjVR`Bq[K#(A+#SR,L)5pEDV
+,F9F`qh3I%Z5,D[5JZFY`4JUVUqaVXq1pGTjqE"8l,F"rh5c`+[C&bBG&1m2U[US
+TS6k)*!XB6A0Xa$@p(2%HFSkTbHLM*1p$B'Km)&RZR@qD4Vp"rEeG0IB(6R6TE!$
+e05p5ZbYh4#aQYJ$,aqFQ@X3DB%9&Mq)@kmpK[hM#Q5l3qM"3[X8@AQpZ[,'QkKd
+'fqiMGeeb9550*S`ca[0iTMY%,H0bpj4!6C*eCNQ"8rU-fBhGeR)dN!$Lr5+jc9l
+)q5&6$BG#@[Kfl`-idpVDlii03dp(Rid"CLp#k5VqGU,0l$h[$Y4p#HM*G54JUYE
+4[LdBbV1Q)P#)CKTE%#0Q2pUVMZB#Ce!pHH8,IK2VCQR&G*JpMRUG8[G9MBrH4dr
+X8D5TDCVfJ0ipF1'3!+@Yf2kj#hmG9@,KGeMp*VNCF%!dUF1B6hmb)(44UrAZU9H
+rrUFpGrGASRbDjCB"(8H[j-p(C-`41CmF(Xr9BmL&&%B-cY@&pKi4e[rQ6d-p$GB
+*%YbXa+X3HKc+hl%ecBM"F+B0iNEm5h&#Ui$pLQ9kSJ6L4Q9Zjm[41bVlhE2@'Kr
+@!41YE)3CUPeJV5G*)T&)lmB8JM+b,rRE+JIX!R%BSYl-GT,4YL)cLQ'N'FG2@Xl
+L*#+2+9A'CQ+N)6(UH2DpbKBbT0LRE96L&+)keA-CBdfSQ#8a3e1fFRb!6BU#qmT
+$*Z0'bIaGR*R"XHT3bC@eM2F,@"#kbXk8phZ9'a1e-pDQElqV9[MFH(%3eMUf2aV
+GM)Y"@[ZANhpM@-i&q!5cFqVMQT%EP+$CbYFf2S3B[&dl6ZI5&+BNbY!hPqS`H4[
+@J0i-54cGr@XpPjV%Rhj&!Y$@U!YTL'2U"pGH*2JEeAbEB(*0(C0m#LiS4iSZC`M
+aLmfQkfXPd![EV0(&(Lm#6lGA`f!akS)D9@X1#bTp8KKSNbkJDXNYlN9Dc4"bNDF
+kfU58VJ'ZCIZpT+#j%`(FQHPSr2BGF(0`k&iZ[3Kf`5V$D2Kh`)R2RF&FE6'3!(Y
+`PMRpa!I-*b14pY+H`iJ'UiPLKTc$&*jb@mThm18p1Hrp&*-Np)K'HD3q#H[S+&Y
+`fBK@*jJ'd%C@Xr+1$4"&mBLY%"QX1pT980i&fKAL,)ff1RR%'`2PKFcUh0dN2YD
+SICZ162e4%RU581E0,Qbq6)fTD*l+k!ZbSEGL[583,!V3*(Mi5Q#"RDik*jLcjTL
+6P6&HJK6LPCq)91@+Fj%-3*m8"XRi`A5phR&'(8&F%ki"kMjB#Gb*"HEG6q`8aHf
+D-*iD%LZ2lK92Jc2#!,0L-Pm*FKIKUAjND0,NHDS"[E2p8j9,YhQUG9`3l&hb!S(
+YFYBjK4fZ(,2r5j+T4'fQ,ic$1f&UF$d9`BPNLp'jL%2QG9HJ2A1Bk*3(j9Nl"YR
+c0PQQ3[+U+Zd5dP+1*%#YpBSTqI(Ep-aM+L"&&'Ak)5#+)FXpSZdp%5K4fm8m6k1
+JT+(iP@Hq!QA!88BC3@5+rYmVI(HB91&P#&J4[k[+"E6bM3mAHH&CCSPmqe0mT)(
+a-2Im#5%5R#,pL@e#GRA,bUZYP!@Hhm,B3`PG*'lL`PXCMKl-2H-*$Z!lG9QCh,4
+UMfk1,mp&)S(PUB"f3SI'mN2kH(limiB1*KaaF[J1$0DSYU,dXHL2$K-@"A[5Tr-
++LG@apMX!HCIC3CCNei"9EJmH&+Cf!ET3RL,#Zdi"pH""Qk&MmbCDFDfiQS9V-BV
++6&9,mAN9qB4dSEj2$eiM#S11`F@lX)%(h8,GZ8%#2bZhibLIY$!ATd2NF[2'[L+
+EkmAc2&bClRGd%BD2IUeSb5AhYL4U,#M-J(kpFmjXGGTFrE41M[88rI9Eq!f`ELh
+3IZi[RU'491k9GGH[5"%bZ#j$+8P'$@mS!amVHeQeeZkMSDl-#kQGPq0VSK9(pAE
+ZKI0#S)+@&F$&H'eTq@,'CP3JS'k@j+XFNlaHprMkh2M9dC!!Aq)T*j8PH#8%"mc
+[f6Pc,cNU2,Z+ii"AMPhPf(@d,@3($CZ%mkrJdGIQiLZ"Gh4dlB9B0)0KGj,8[)Y
+@mCSJ$0lp%1jir$Qd%8A0KI*2,'EHKAk[%d9QArDL#GXY2T3)LIPDb+dA#6(b8(@
+-5jF4a2@!#G[5IBEZ-$13!*bCNC[`3a%%j1PY,mk%a*3K93aq,hJ83TSGkqCZG`#
+813rA#YB4rFP*9)%d"9-AbaR&PVIEU4SKihZmI*LkbET#%-SBCmS&Ji%0%jfASKp
+6!CI&FCTb2bFBZ"8FAVfX&-Z$Z`mjX"'PUiL2DVI3$leUFRp1J-"J)pT!D4e*brr
+SU9Nc8Ta(IcEG8)UL2VH+BjD19#Q@00"[S(CCVeN++2Zl6$kHF%9&"b4e-GiINHp
+0$AlN(5dX8"YfIq2ClG&e1X-bT@iX6+0qT1EbR`(CPl+'J9HL!a$)C6k-pSD))BJ
+l9Ji+4K9`ArPljpE5rGjf$EQXaF1HX,dkHN6X@NEBM*e4Z4RrCpErC)lL`Zf@9qd
+PE+G)HNrXh&f`6FA6V#qZ-[+f(&6MYMrPrJ5"H1dAPY54GjAr!G8*dh"-fKl15-i
+9Ze6TXS&!q%pcb6V0XM-E6fVaQD1NeZIX2lcj*f!DY8X3'BCGmafp3qeNI$$NN!$
+A06[`KhrRkA#,Cljf8m4ed0YBPac@dT%CT[bP%Z6JIXH,BC-SkP)Y(T!!E"DaKrT
+@(hL-Vq"%Zji8Dk!i8"r42`BNMCmF4CjUcUXmZK*'Qr-9++4ZiYk5Ml+a#1&(JRi
+TC62C0"RP8@M$Pie5-c#Ck!#4#LD)"ddmK"b&@I0@ZKH)mJYk%4`+b5QPPVP"CrG
+EHLBlU'`aAJ92j*VRH8*3'fTHXArZi3c)XAQ2T&10fK'D0PhEZ*p@8B[50+*!#m,
+DrU(p+cIfX2`hIfV)jPq6Cm9`YN)2P8)18USHV+b$!NarUR0@4YcF+&,+5@QdVM9
+kRq#eB"A%aG8rdCUjbGj(F8Lp9f04Z*cpDM)UJY5US,[%f$i$9k,)VG'PrjP!D"$
+$MhS,1)3XhZChbIIpkf2aIC*TPf)0*AC'b)'+%U9"c0C35pXM&+pHVbC@DcjklHK
+kkKi8$4Dj$me,3`ZHpMj#*"LiT-!M@q)R*`PKP3Ii6++[RBK1*3$'142#h3Ek'")
+`LIa`!+2SG#RZAY5l+r9qBISfViKp9jf4Lm&LIdrB[pK%NUH(Z,1Q0c*#Q8'p&+%
+"br%ip#0fX8--143b6m%`Ki$aY!kR$9VDP6,qjV9`0r-UJER$M%P"LD5&0SXR8#f
+M)a"Z'jK@4XKrApU"'GNNCC'bhr$Nkil[5lp1fVZAY`QcaP43Jb4`K"8%rM94$*h
+e@35cQ$[Z[-VC`Ckb!ad2h2Q$rHBT"j)-iM"3'@NB-XVmhEYR*%!4Y-9dDfd2i)Z
++"1#rDB5I-6"bddfrH558RDDpelj-%q$-dV@[h,kR85RCr[5FN5iEce")jIhDA4j
+h'#Qh&q`4G+0"J#j!+*R@I33CRMJ&&llcC8i&)54NlGF5Q#1'&C!!"ed*2p,M0JH
+MBPEVM1P#DVN("$K(3JYVNDBQa(GK*'JQTa89!$Q[Jmq)mcm2(UqZCk%""'lC&pe
+BpkBkdP,p1ld5A$V#9+eVmHArP#i!H9rZ$`c`PU%Zr'h#j#Nrc!&kQN@922Yh+`m
+F!`pNZG-U,fk!1f%UP%Dqeerq#CDIZ9alQE'lGYX)AC!!HFC%84%*!EY`CU(@jD[
+U'GU-f*qlk1M+A`N@af[rkpdY!DQHc,(jlG#Q25GL6`9,8IR1laYVTVUjYAkF54R
+d#XV2B,5$)ilR1BrGi#Jlb[Fe8*1'0J6BV5r-)VfrhiLKf)YNdD,iQNLCG6BJ(QC
+F99NEjcVE4i"Rr@Y8P'80%LJ*Q1V[-E`XTlR0XV,34I!lb5@&j(lH`-X8Tjb2ak+
+K96#2rf@dJ1SbKG9J6@K2%+kdMC*'+BSMR'P#NL%eL*BC&JSb8jKhY1mm@cA5'EZ
+(PXPBDDiTH[8Q5rlNd0GR3!$GHJEV`KaGim%kHiE"IY&hFjNT)1!"#DR"eG,rYqh
+@MDEUH)Md"JXKhBK"UZ,4ZQY&j3mJqaQf"eXiY[epZ#HhbcfYFLNae%ffZpihjp`
+ZpIVdi6bj'8rkMka+%XkVEQ%@9Abk[G*$4!5!2eLC2k,SrehT+0Ri2dX#mc&M"$E
+jmRH(8RhZ!')KAFRHE%DfBp5i%M%aGeAR#B@[D"m(Q63iCIP5[)DF)2km(Za40&S
+h-K@@l`b!0EN$TU95FM8bS*ffdL,[+q%6q'YJGfDleCcGG5H!`'Y`6iZ(II,5hI3
+m[G&Q%Vm[cE8P$P`!m'ldN[`$#BFhRS[lb2djZjX536*C-K"+,fUL[d*XeTk2l9G
+l#04h5iILQVF+9IapLEh-I1P(c,%9bT-f#meM(Zp)QVFbSba#IH1XG*!!miXhGe!
+Fd%Ubq6mb(Ij[e03XJAhCVM`4M1JJm-LLQ8j!YLC1qT!!h0Z-Dr`93bFfi66@3qb
+$1(3@j6%H$,&J2dJ)!@M,((SKM6Dfp2C3i@KF$l#`VDX*64f-HipqF)HKqEJh!3I
+MJJ1lZA!T2Z-%KT8Y!NeZ8E5-Z5A2MDKEdk3!'E8m[KCp4LQIp34'H1'%HN*2)3j
+dZ!ppVIQHm'%BTr8hT2H"X2eplhIceSd@QUQrXD,SH9N0de"RdQU#Crkl5"FkmXF
+!FAa)0`#aJR,k+H#EQAkD#Xk$!@ZH(4b'@d&JC0fYRPGAFmlY3FX*1m8#(TiB(j[
+H)DM-GljT#)VPa+cSKlmi#!X(Z4-D&#ZIN!"Jp*+Q*-8+9`I5imNAP[HXf8YA+bR
+)QQY0GrFQ5$S$ld)&eLNCU)#!K$QArTlhGM,(Y@X"9ck)2$beZ*Icl$QJlU,EDkq
+Mb8Ka5-H(SS$MhH[Ec@P5B+kaUm+YQeGLbHE4)'DGKhGM"'@EaR`YVH)eVKQQ,Z*
+BN!$"LGKJKh(3AK!bikifAUfDQJXjP9ELm2)&5D+h)8*J!#9`k%bN+i[Mf'D3!)c
+`lZF9Y8BK0TN`aDMI%DhK430B4Ya#'aJkPi'&`&1546V#ZCA+pkTP""5&H'HFfam
+Q@d$T0Y@[4*'Zm&a(QXU,5LcN$A4!YIpQQRaTBq@+hpJ#aEPNB$6+Sc0H+rI8G#J
++%Sk1N@IC,6h31lq',YS[h)+iLT'LA,eZ1G&kZQ!$UX`&aFF$!ZKXB9ElAPY%iR)
+UeB-*beh)6*)[8#a4ML,KKK*`b@SUQ-i4kc3Eqh+JFrSGm19RC%F4r2I@#U,&)T3
+0"fe$Ua5k)3Ip*GSIelY[*@YC`C3h#TDf[RZ!k`*k-p@KdJSh)!bG3ad"5R"NB-E
+52hA'j!a&(e0-TcF4G-2r4lbRhM&P)ab+9+Q(*`Z*a"JXJj@q##`(RcHSH`a@9"M
+IDCNM[-+lU-fel%NHM@!pPF89jqB65fH8b3+DL-i0Nd0A(Pp'SA!e(`"N+2#SIGj
+@-US%c8mC&#XdT"B@8LAr[%!iKHLp$!VkpSeN%JP`VK9mE%6h+*a5Yaj4@pG@UC@
+XM94$eM-i&bLYajFbj1ScANahM'@)G-q4K4Rd00m-Gf4F1PN3%r9cRcm$Pa2P0+4
+'0iTa`c(CM3FKeaEY(4eA3[2Z@X[H4mbS'C32&q'aF%M8if,iiK8M'pKdm`3UpV$
+cm0jAG*9qR8DATPM6STjFR[riJ6MK1+Xq@'BIq+hcCbX8&45d*d2Q#kCflfG1M%5
+ihEEj,eM0+[f9lhqlkR&HUY@e2-M"+%)`br*r9&H86MM+mP$pZ1Y`NeTdB83%)mE
+3iIVZ(,!@F`15`@Tkqp(dNdBkT[iQqqij,8YMh(eP[kVKbrX-3TdKk8ePC4QG$CD
+mEPd&f2)Ji6qTfM)I*c3$@3,QLUIl`!5FfCRSYE39*0J-T"eQEAm&eqk!8fbfR@N
+qi4*Ne5$*iU&60Jiq2SbBX$Qk1ld"1br%Zr!h+Md@k#DA&4%2f2%XSU4,3IS&#j*
+ZS)r#Q$SkP4)0"S56DPHpFMN$++b*3RjbV"MLThJTE6IZDYFB3ldC[-55a"IbmNH
+85!$i`8iSSkKPp3(L)'22CF!"-liXeL(`36LC8YM9'@jXj9e*)frS%$E&ib5k#Pr
+h+pS8k,9ii4kBM#!P!FrGZ*ek@DRR[D$c3V-0mBQI%V&Th`c[4Tdc&liedMV!P-k
+DG,51I4jcdkAc4pb-LP$0Gjf%qY+'6%rhHld,BM[Fq`0mZ&!,rb1Ea4a3S6%diGH
+!lDEZAhIV&RX-)42kfk059(90fE1N%')E!AXkAh0T2R[Fph3cJUT$KmL9*YR)YS[
+JbI0MmFEG*$"'jHDij4qXf1IGZB"RUM-cN!"1[lB@$%BJkVEc6E-!3@(h&FY9bSZ
+pS`p#J633SSHfTDN0YX26q,K-`(%$JjZm,r(22Zh'4),G36rZe[21TCQD))iFQAY
+&(#6A-`r5`P4ha0c((ACDUrJi0-D(k`ikZ)@Mc),X4,3k!0`r5R+m#R'AK+V!SI-
+QDA-,jHj"KrF!#@cMV%c"6PEDYdjK[96P6-d[5)rH89jpFQ`fi@Vi"J,YfGFU8dG
+qBJiR9'@A)9FIE,"k4UmfeaHT1HL+l6HaYaY$eMNJGj4c'aQcMKi$[H-VV8S3,1!
+Fe9)V+qJkU48iVT&)-Sb*r6eERR6MX"p@U4ZkSa(T*ame&jGiKXI2eN`H59j,%$#
+RS-Gh(FqB8&iS--lN)39hh`-*Q9T5R42TX`pGTY!PlAZ+KIQj"U1a+d8NRF2IaFN
+H4"eZCYbVPQG#CPqVheLB5EE@X)'`0h#mM%B@4)qE`0RR,(!ma$,5eaSP2J"flKY
+pi6mJ5VN3CfXEZi,PRIE3SR)&rYqHeJHNNVB8*45r(%6@[6m@LBTB2-Yrj[RV+Br
+F*&DP!A4,D#SMVH@CiR94U#"-FQeC8KYbl*J+JZY*,i-J4j'Gf(6aUiIc8$iDpZj
+hh"hdG9cXLm8Aal"I(5BJ8-LYk'@3!!$%6DUD[HAT#0pc#kZ*[2JdVX1+Kd([II'
+REep,B*TNh!mjQH(ApDpGC!lBhYY)5L`Ibcjrjf!cVX6)D0+Zc5)aN6!X9eR1r"f
+4jEC3G!cc`!feX9DNFpTkN!#L4RFbQUJELXfd1[4*rP%E&%dlbr8lZc43+ZYJ[jM
+XhrEX$GK8(LhJ([1TT5H[9DNmUcrA(88cJ"9lYb,#T+[S(,rNec@3!(!M&pepil#
+3!'R)l9RYXSL"*$-M*eqp$Kl-(J`B988C$BB'L@`Y[q911bEdIi$2-!MhURk5Pdq
+X`[c[564Gi4abFhFZiNiAkhU&RfcBI5prKjJX([YHa!q9IFm0iP8(,-Z[eQDTG3`
+j$mRb(92)#4XLff'9+`hZif#V-6d9RP(Y8m[V"&SG!e9,&XIb$aU0RJPpe$[q0+)
+A9"ZbkpmeCjL@5V(cJ5"M)('cNcF%hf[XiTSkdUiQ1+`-SD2!,9q--JQZfkK,6Zh
+E&*rUAk,r3(F8#BfYd8!1pM[)02bP,'Tb-a[lrile8K2bTHZQf-fl'CceSJHLK)$
+G5C`8F[d-'RZ!@NT)EUr6hh(h9C4EC&''(,5!M0P'[GrA[iH++[,Bbq4QRXTA5dU
+,*"Qb$*9L3Y91b$B!)TY3MJ,Rpa&iIm6DTb$M&3pplpGe#Ffi##6BFFD$M5pl%YS
+R@Y+'8+@#j`U13HQ!N!#l+MMEAVN%%M[pf3D8@a#9cl23J$k#!L4@VI2#d"LaVPX
+NbGF95``a#$#+GUe0*UbRe1%8D`m!'3B[T#be&LrQZMG!qNb08V`#H[L+q#r(TU"
+`PE5LV-bX)`kF,cLAFY,FpakPX+#S#Q*UA2FZfi*crfI3(Jh&8J(Be'SY-8iPHE[
+V&a42Pl"#-A6ZVeUqDr4J9I[P@fZieGQ4d*!!3MT(XMMLrkh,29TMVR(qG82r"EN
+*PAC!PA8k9&6mZrNIbAPqI-U0J"j#2L)UKh25eSLm9ph!jj,Ee3VR,L`5c+GA!"+
+UZcCbSS8fc0VjaUcfC4p3XM91c`0Ib0&BSj09QleFAG33e9(10ce2FblmeAd6X,e
+eHU+K0lLkI@KA"DZNK*E#8P8D,j&j3FMT68*TMA+5ep)9eEch4hJ"A"0+R+@pMrh
+8Ti8Er*aYXb,b'J125TL@J,E,V1QLT0Dh*kF69#m$3idlHTl%QE'AHZXq&06qm,8
+8G4h*h*1DNJ3!5Y9Ld+k,l!p0YF--d%14&4e&*@0lZGGBKVF!jp2+RClJda+[TRi
+,&G,D@'EGThB'eM*`ihJhp+mr`rp*!pkPB0r`202)N!1l2E)#9MRph@9P%cYFedq
+Ck*&kQi@,0B(`*)*V(rBY!%1#3HK)S*kc"-`3'aBf3",e"`jbT3UelE8SFk,BB@T
+5BL,KkPF'm$"G0QcPZCq)I%Z5S-fSq,KjcBNqlFSXhCl9BCV1!RpEq2SA)4Y9mXV
+l3-'4Z'["XZVFP8c++I(+PrU3!m5leGYeL"fNUSrZP5@m9C(!DbBc,%X@5)Dj!hM
+32*'J'rrc*dk,XqH4Q%#bjaAc"hHr4)l`0TMU'[$538`1[0dL#Y4(m[S$rVf48fH
+b"bGNNT!!4%-G-hi%*+%(6`8p3'3dF#%Lf+!k)QaHHJ`hQ93D)X*'R3Q@m20Mf$)
+N$%RSH1(daDJ`'!FR"raAbA2Zk"&+%)G2P43kr@`'-I[iN8dBabY!IbA'S11aJBP
+KVH&'-HL2-,M5lQQeaHF"TA68@K@iq6f8B**i1McAMTFTm*@Y[,B4@"XYer11Rd"
+[*#VB#GFh`"TfU!$DU@4La@K,9+h1#8&V1$RRJTFH@jI+m*iC&ej2Xf+h0SNNZD+
+@,G2VJA9S6PF8F(QK(`0HAN5TB[,JMK%1hRp)AX&2*,H9`CF(*S(F6k[",KL3!'M
+CifALkPTde,"+6F*mBNCP0%iSli59MeD)!%99cjIR%A`(TU%BY6qB%D"YFPpr09*
+LG'GTYVic(-h,+mj&GZ,RN!#",Hl#febMP2`&&,#8BN28,GIB0ICI8rbh&EN#5q#
+cF)QrE!d,&Tf'$U'J(eiUcT+8kQ@3!)Y#qrl1ihQ!S4RkZ$kiZ,UMdS+*46Rf1c#
+mVHe92jl*X'`D"j2rQH!F[BFaZ5Hl1RLr0jUK2&rmXUPDj@U2NbIE%2U$fmY"%[V
+R(J9RB4liIUe+YIi-D%K8T!3JJd&'G23J6Z@J8@HV#cU*@(mE%DME(i*JN!!EQ+Z
+irAKA"5iRD-9M*aGqV*1('@ZC6TGJc,553!$Fj[AMKCiCj3X0I#B#a)Ib3Y'#)Pd
+fkeR,`!l-#hI3CI(3iVaXVXNQkNVCaklZF96a*m8BS851G0)$4&E$FHJ6+iYm'@k
+j)@*1[F9VQ1m#%r@dcTPd[bdb'+3GKV#&J6p[bk0PLj3Z5`&[Jh6&Yl$i-fHf1eB
+9GGUfr$QAG!*k(Fa1ih4hbh0a0IZ58%a,j$0SI04)YFASMVk(G'F#DH6@'Em*Zl-
+A0UU+Pa'G2rJZ"$")4RLAdC4F%0!1X`V@,e$KA"c`Z9[j#bDPFDB+P%G4X8!-ElD
+V&dTR-a([lRMNXC)rFAB&*FUH1ZB`#"q#!A-BR8AL'@N$,C40pQqkPjEqb5hEi`&
+aUXa*5L4p2'V`LNCj`(LQ5Zk3!$*GiGX,U"4DrB-$eG3[,(UKlPZPr[rf),GSUiJ
+cBNI4(ID61MRkLiCjVFL*NS+pbBrLlkqa9lphqfHH@hNE(kS#Y#b,$)@YX[,qK@$
+'4EQiYHA6q+1[9f`)q,m9Sl883TZ0KNk"[Z"YD,p55kDJ-(SJ%TSrq@e3$ll@8q(
+qhdMm5%D6R-!3'KVFI,i-RbqQCM%RU+HQ)RLh!Ajm'FC*K$QE0V1mLK`E,D3Tl,V
+Q,AI2!h(3+TTcVr5f`GadaT+`G6JbP66Xk0Nf4DdSB[CCH-A`T,*44!QIPq+V9M$
+jm@GVL2P[1e`8[c%8X`D`%,e!jT%-c$V01$X6!@*,TdUZ`Y@(,VPl3j@I)%QBKpN
+XEI#HGM6jmr44MqA0hJh9VDrBL3+[p8LRjqq9A5F`jA$f#jGP6e8$G3cEUih8QhD
+SADAZ,C(G9DqChj&J@EbMRS"(`RkU&SpS0$qPqbZ$V8rTGJ*"@YrrmM$$!914B'r
+mRj)-4i$6phK`qhaN'H5Z"6ZI(bXhEmc2XPhk-li!)bK+m+i2jehm[KqcKMm39BY
+6,rR&T`U5L*qmZ@f8[VqEcfHd)!00M-Iq"AAeN4cqJkB(S+p%GK05%ZN,Q58d(Zc
+M"T*C!H4(-U#lBCAC#KQdY$SHjmT9PFUk(L'ELAlBV56P"1EI8VTij@eSTpRCk84
+kPRTNce'PYHA()D*)fPKmJTfbA3'XG&2jIMT!8q#9[fqD)rL`Rr[&VXRRQ`9[jRF
+1*cBbeQdilViQ[e,q5[CT6)8BN!#F)J%mP2)q-R'83QR8T1"5QhIdGZ5qPNrSfcd
+IUT2ME!U)h#m[T#e5UK(0Y-[(fcm,r%@B$"RZT1*Kr+`#89#!%+[31[4KJ`Jb)-6
+m9(qb+X8B4j,P2Ip,J$K5&4ik9l+1#CLea8kRJ9m)NdN$`GcKUelYiNb[Q#Z@2c%
+phU*$qrM1ZBfS+R9#VY*ilb!9f9G%4Q'XK4b00LVSZ[fZfAPZJNG(+KBMrmKZq"K
+PlN32Sq13!-DEIV(XGqZ-2f0PQ"MFN!$)M8"rq3""3lJ-dSHMm&+V`X[)'"krAdA
+LiNV,a6BpYG-l`)a5,52l-D*BVKf*1[+D*9fZh0j#E!mE%ep`$l8lE62Z89@-G%K
+QD8,A4#mm0d$M`TF@10jL2qCPQ&&S82iif(lDM%8Nk6Mb)ljl1VkCcDbJ#&B#m)5
+5VR-&2fl!PB%Rak-01`114"IXMqmN#ch`)m$(qSRB$1U12U0IcX8!JA$Z!A!,CE`
+4TCbU`aZRjll@-FR*94l5F'DdaP'dd'`Ca21%$DrIT$3'i#)18Ml8$NcGeE(Z&Xm
+VKC2epaLe"Bj,)qrJf*H1,)C5kSC)liq,Zaj@#kk#6lqIFa*$5lQeCD-M84JlM)a
+ridfkVb"XB&LRmR0@S`AjT6ADkFDIhAGjb3XEp-3CT((C""6JpbUHhT9XS5"LJ`'
+e`(P(f#iQFB8eJ"Uk+T+I8pTDT!NdCY0`*Y6)j9aU)"MKj!&#P4q',[E,8d(h)j!
+!c6K3UPrK9'VM`TYm'0rCJe%65)Gh#l'$%mFIG@pL0C3"Gd28iDESqk5dbFX4q6V
+d6052'F)9aPh)LGB+[HbZ"1J15rdQ1L"AF`cD*CLPJUSHFfd4,&2Q*5,D6e$)fGH
+Chf620,AQJK(V5IL1S6CVje"$Qp)$U4i$"3i[T9'MZN,%8R+r)H8f!H%HHV"38Z#
+V!URbNUEG`'EK$bXC)#VN9[Qk@r$1TkZ(RFm"b-rL4&b!9-k@h2$S#jNS3UZZIdl
+$Z1V$)J8CdVPi%Lk-pMAN&D-B-S%MeJ86PG$kM$qEi,X3mB#*B2bFaRU)6*kY(G1
+idPYMEc""5[20[200)@A'Vm*!9N%(G%KL2X-@r$!hI@EUrD#YNG0mXGBbA&Fkf"h
+ePeMai@lT'91!i9'CfVA+9G&BCQ5CSf@KheL09Q)K[FTNJ2C'UNkVSNiPNH*)PSa
+YNY9k4[a3J2fGMf`%*3%3H"QFkQD1"XUaM[T%)+qdQ8$k5#UZXQM)'8SVNfhYpJ&
+aR6F)CcHkXU9pV@-IlJHC$8S%F8%jG2T#mrLS"(,Hf@a,dDZ['I8q0k,"bZ#P`8!
+3%&FU1ip&6TX*NqBDe0Nc3&$*I0G1IdpBcQA(ffM%qCeriYHmaFUd-JP$VpYqKrU
+jBFBQ44MeChZhh1"N-$'cikK9M5Smrrj3f((C!F&F5BUNS)&bccD`k-GiIDL"3Ca
+-BlAFkCqPU1hL%Q-,4!&QrB9!U3TbBjAb3,EQTaH(+rq%l8SX"S$#rP9&j*ieI'a
+AmB18CZ*[82jKF@ED%k3kqD!q@*dTK"4[F,ZqV&-Dd%eai@Vfhb$64$KD(MM-PjX
+P0(R&+@chD3,-`!ll&k`d'e4a%XirIF'1eSFlkJ&MYr3@K-(R,epe05+kh%4AU%3
+FCHYLJAl3[TkA(AXr"eX5QUbmiE04m"GHBeY2$a%2JIYq`00b*R81r[5Sb2KQ9)5
+RF#L3!+cV&@F[G`0%pYmY%KE,mC2)C5H)DL-qK-@96YN+DS"4365)80Vjd,kXFfQ
+YR%qCJ"Mj,aP$BeZ(*f2%M,1T'-akGebm5hhX4lVfZUpiqcq)(%$a0m(FNlbA5kN
+pAJ9XS2&ml$GTGF3*V"QJ),aIr)cSqH#&GDfA4K@'5!@*JNFkf'GYmAjj1h[[[%T
+3e#SBZ5H-MU'CQ2f'%UD,83'",B@fG4GFZS$*5bj'6QaNUI!q6d$9&R&N#)U+ZfF
+`*N@I+A,rh4GG'qML0Ac2%,b5q[[1$kh0F2,lj8fb4E%N&-9&eM*i#%PHK`$R3qQ
+(Kl[baD#24-p)2Z++0$(rSJI%)XRb-ENiB9cb&SHkHl[ZDL-F(G!c)d0GXK)+ckJ
+a6%I&clHTprZ&%XfZ+G4#iY(%5f1AG8c3-#kjIIbN@4r@6KP,'MkYN!"U!GVa+M(
+4M'RFNR0SNcLfdjJDZqUb+&36cmL6+!+3!$'d,(Gr03&*iA6+R,c4T1"Y2E'XN!$
+P*b!6('LXC85X(@G!8XCGCeUh`%3r*jkSMf6$IdhpSdaE+fjLQQhiI,,IJaJURaB
+H&4AIaPV@J,Ce+G'P98h5(ECB'3fmqcpQ)XY[GCMdEfJPjV-@X!L+J`iFU2SB,QX
+Np@cefCP+bqmK5LG`81VUqN"9K$RK3[KG52cTb&N)T5qrKPGUK0GMK%XpFNELZa2
+rclN9c1LGDc#m+q5G(1JE9d6%9M[IbL*mR8aDpHZme&RaI$!cakSHc2A(-9dmhdB
+eH+MFq!9mQlZ3!+`r%I-E$B`V1dG+#pJ4+'CULZcdYfAF8k3j'kelmEhfa(rD2M@
+L-N,c#rBSRmAd6fFM[U-9E6km,*h6j2AiQT0J0)l5M+lS["S,ALQ-"kQQ&%J!HiE
+cbMZJ)TkkbaP#k(d4G,aa`f49f`,BCB#B`kda+P1FQSd89,YMBNC1kEa'9ZCmir1
+%UK,`i6YM#dZm%S)5mPTEaSi"K@R9L5cLhP6SF8F%1d'p('eQiYE,bX2HC2c19*k
+YRA!K1#H5Z9a9BCKPe2GYKYVlrq6YPp8KdC+eHI@+-16,AUHq)rSQcK94%PKc9d3
+dXh)*B84+LCjATR2DJf5KQ&+p-'k5j%4JfG`KRBEVGX1PRcFU$3!-BJ#6a1L,3`3
+Q,DNA&HNS)cGmR)"kZ4!(I@8k'+h%3LRd&ZkQBfH%b-*83BT9rlFp`1C-aU6i&*G
+G3,iJP%@Kk9XiB,6H8hQ-Z*!!!0J-U+dm$fjql@aAIM,(PK$G%L1q35D%8i$b26p
+rA80E-6!&dPPS3AhYlGp#[Ci"C@BpBe)8XU2ejQRRMM'S6cjmEIXmqN)+%1CM,'B
+Nc!M%djBQQ5'jP0&AYlVrTmfQ%B(JkaK2R-ZQp(F@qUlqh)j$SDd1pE9a-5hRmYU
+HK!KHr[BeLJM'2eKVG-m2hfE%T,LZ"SLrFTpN+[BJUhd&CTCk,qIV#BlEa9$9lD@
+lFMXKj1e''H)qmZ"A)%+K002RqVGp-96RYddC-S$ArDB2K*IU%Zdi+N8rSNL50e*
+b"UNRbGpFKC0*#!NEDeG*("@2U1Ll+mb'Ti%0hcR$5&YRG+%Il*!!2mKq9Q`V1S`
+0IQREM!NRVTKX#ZRU0[!DaRN()MK[RrKEdKT%5)[(@TE!-V&U&,Brq$H!AGJQ,+C
+EXcEHRE'k@9$*ZbeDKM`)b[f)5H4XHCeUABi4*`M,j-+iRhl1b&`RJCSmJ8!-j2r
+EqHTFmkQ2U8*8+Gi(QJXe"Ck6YERUL,4R&[c[rCK%2"h2J&0FbMeD[8"CU(pmcqT
+UKr+B[J&I$q(8Le)Ndj0$H5`jKNT216[i2QUGUSjp!3l"MF,32qZMH65mFlV&EDq
+Y)+EcLqd9J2B-ZL$Cq'ZSLM+((['X1MYABqKL%(Ua%qHkFF&rSB&QcbG6!8%p*H3
+D#Vr[TThUiJ5`X3*ZVjFPJqHG$id$(3FVCc$j5%ZYXQZJXUTjXLl`4qcdM0"&!"@
+KP)BF@i(h4GAriDppKPMP'!-mf`KdU@rJDFQ40kJAq$k(MqQMB%Idr"ED!3lhSPf
+mbCN'rTJJ$-[rG42j@VmDD,Mj)-eXr`b[KTm'a,rX43YUJ1FqJ!Bbk0G-&d83TL@
+4HK92Cm!c[dH3!0ZK+#(+[H2L6jV#5CpMcj'2-5(8BLQAJR"k*I`+!Dm8+Mjd6Ii
+Y300lb'q%S1ir-@G'X6-U35pQ#D86`*f+)19ckXd0G4bUc`K4PCT[`l(-L'NAAS3
+SeV19!5kjdE1XTR@TbR-aSEib(5V48Te"kZGZcSQde-iYUR!'6#pR*RJpL,!-N!!
+&"f"0Y9H1Sc+IBTJlZPIXp-bArJhilDh%iL0k"f,N9&Vk-*3I1AUV@VPAVV1[a4I
+c0K0ekGX!DC1bU2B3@F3d-T4FqK&1Hree5%[-9Ak'`VZY3l$MSS,+l5*5bjS($AN
+86L1S4HUKZfZl$H*pPHfQp"qSp`,l4l#8PJa#!68p4V2X3Q)!$Pe5&9kQAaN%iQ*
+hid$*4PG&q*B(UBkdPlNf`)&JX-ep"dQHl)#"CEi!'"bHL(3dSba+`(0Mj&2U+5D
+dD++SDqqX!a28Ea@1JA4)UNkJdk-2&+6+G8LA4G8D`Xk'hh(ML3[EINKdRGGT'GZ
+%$'XA,LDj"Nb[Y%FefYePqVD8cM#BdUj"G4DkMe"m8+!SF,bM35&R@i,6hqU62iQ
+5J!-MpYp8E0Zm8Bl#A#cIfTiBYGc$AFVeU@3p$*R+RQI,@9&GA4(K@@eTU,Y#Y#P
+[qkA)jG@UB%A,rajl'Ji[+"ahbpX5+MHEfFBQ4!(h#TqdGNC&!IjA&EHMaPS,@%H
+rk[bTUD3Hi&de#VN6J2[cAkD!K00'`6K[#5LG$FA!bqE9jlM[%@"j@Vk2`l%8VFj
+)a2'EETEYPFHf9RA5"!2Z-8%,,S*EMflX-iFDrY)#DbU,M+RF!0A0'IC(Sp,adZr
+#8QAc"3Gbe$YQNqZ4TIM#6*P%EAEk`Y"Xib9B&hM!%3SUmiN$A+J4-6ITakrFM!i
+Tm@P!)SX8MiNI"1*TSXeeBCf$PaI3XiblF9PB#h902R!B)rG@2PkKkP2K9F3,'6S
+eEc15ViQ1Q[(UD1)eZ+GC)+H*`-+Tjmh"e'Fr&PRQ)aV,YJ-f#NA8T3mLdrBr`MB
+T"h'FUcllJB,@DU+Cmp2UhYbI5TrAh"T6k"#l(0I*AC4c3e-Q1,b(Vc8"D,DQab*
+HT10bY`BYi8qAlelZ9GCSb+Ql!"f5LSMhpE*K4FC[$SjT@dfV!1h$LL*5a,#RGXk
+,JPU2f6JK2M1Fe86#VTkDB4kG4DTd2'+T%cANILhr6@%pi+8#m5IV3'l#Mi2J*$H
+0Jb6JD#rG)0cFj-"IiB!HCSfGj--(aAfJk(lYhKlNh,XJ!BafNG#6,R22Z'qX4Zi
+L2kle[h`J-+M"9bYZ,V3e3hf5SZ,3#0N'lUDiIhEcL25)G+UX8B@*55GX4EkYDT*
+Y*HaBPLCQ'J-J20IMI54#V!e40-jS#dNr$YCBKrPA3)GLGc'G,8,Td9N1$NfT)Qf
+X)B85m+l'"CjI'lCBq1*d0FL$&ahlJBBaN4G6e[[&8Il*)P8-(GZ3!(Bi%&DGA%f
+2$Db'SUr&c2i)MErlhjh#1cJ'GEH3!1k*ZP!T1b+q!2fTXmU8bk@(mrBG`Aqi-ES
+J929pb!!Irdah9`q,X+eQpAmi9SK2hPP[hDdhbUcC%4,4)CH45hUMSabIM,r*JV"
+diR42Sk3ji2m@Qc[d!*NJBckEhdMB9LipBd*UkD(N*,",",c%b6"0P!rFiSiYR,p
+KbC@)Pi40Eb+JZQ`3,aAi6G!I@+p1f[-N+D&iahp@IKHDi&"*0TL+mIVHQG41lf%
+D6Pbk6"h*Hkhq93d#jN!pjKK#"AZ9$M8-+*HCX,!X(jh$HLD)9icKr@!`H9HFk#H
+dJ+bd5FLCZk)`*!M$fRIbe[5,(0b[DpC01E"(9Hhl`R@[kfX6%%LIP9rVZ*0YS5k
+mIaa$$3E0!DGpZK#rf+PckalAbS5bQYZI)$"(a&Xp`K+cF[IUh*[fT[*-rXVjiiU
+Lr!-FIb6(ce*EDN@#[Jc[LB%dXDQ+k5GjYR112,AfK5S9**2"@-&Cea#U#rh[JPH
+BVcEQK2bk8,a"Dr[)!Pc+m@'fM*!!bABEFc4&H3L*qFm+[*!!e3LfP2!Vq30j[a@
+MBGiNmF!QUrFJTV9ZK,06qV+q(Zr)NDkeDq4V)QTUhN,1-4TF0F[5F0I+`#HZXN*
+qa+45C@pGcfYH0$6Zq#dMc6)Tj8q"*%bF63lAbkYch((bQ25h"CdIL9$#&2AVYhi
+V&RY3beL%C0Lafcq1[iRU99q+RfjM"4IYN5&15fd4&rIYUlTl*Fqq`N,mN8NS@cZ
+HP*S#Ed`Q#&KliT08*XU3!([K@019Rr0@qfq4dhlHE%Iq*[lEpaP4A4RMfM45K*j
+jLGBYr-VB[JUc+J(@rMLLqGH!iZaJr5Q0a2SAP`bHh&Cpc*6@"6$SIrF294k&YHM
+qr[8-M4aB%l!6q32#KYBC)FX0JMU2+!i%`%8KR'%4+*,-9(CXTFJ-RQ(5jQ#1!`5
+`h9Sl'[*Gm9(i$@bm*hE6Gm3jZ[[U8(QCaKkNk8@NM&$U-'DHPKm,TYJe1c8ihDc
+eiNlK18k'#h8dZ#0KM8!KR98Bf[jQ((),K9%fBr&2CrGU-i6Da'%1Dk*G-3GbAjP
+b2ZfMTXGhq@d60K5$Vk[NEfC$cBJ"DV9DV&HVNm#TP@d+48lHUR00))M#pY)!lVI
+M#(*AA&P2dJPFd)lG)'S)K8`4#$CK$jLJErV9@GPdHB,k'ZBFK1d&G&aL3C@jH-'
+%4S*$mSSjVV5FiUD9G-`5U8#$[f!SACETV!#Nc(Fp-9r&UX'i4+1T*L6TH*+AJ63
+eTT6lZD$2PRi0ALrFJ$@*c#p5ZqFqlApH'%mJ#+kK@$FKIa2@Td`F3Xf)m,aeIrF
+K&K`G,'0'Ddf)5Cb[V)Pr1l-''j*(NVV&`"R925"1ZQFdD'8l&Q,q9e2PmZKi1@l
+!#%+UElY)5lXmhrmjm(*cbA2&Fi1ABLj&VLBC06&GqZBD*r5)YRC*"LpC&@JD5%M
+cY'VckVdkp@9af(%6X0+#EQ(Qi8`Q@IRBE54k#U&VF"@%0HEmfC9P0jU0P-f,I#@
+5f905@KMkI[k*Pp+`m5[0qR@cA&*HVdR"RMHLND'$`QENZSm@8j6G0B,MGD'S@f0
+,BKBhr[2[p"AdhedD+"F$"k*5)kT!p[c0pb$R8C-!JaT+dJ,M-pM590e0a+Ni5FT
+XADSZi`9rfLRY,3E(L35'hT!!kr66d56@RL,3Ka[$N["id6NiGJ@0JZjT1#2Rd+4
+4JIVleQdDkDXhNhUA4fQZbSb,AP2+"bPE(!!R-3E6m9+UZSpJ"JCMTNb4SKXd3dX
+-p[(&N44!ZRCZd5JLGF0HkZ"FZiK3"9YC"fraFkP*`D[cG%iLpc,+65hr`2Ah,ll
+)f8DjJ`J0e1H#91XYeG*6,hqQeRFaDpJE%D`GSSY,QjVprmBIp#,518m"KmP+0`A
+(L1bFPErD@Zp8H&AqA01[&R$Di*`#33rf1bGV)*5kk'L5Ad,cHNB38YKQ"5Z5fKi
+8F`6YdpR-lH@aJ&@d*[9,6riF"KJ0iiL#%`DLE()"1$3rPA!rPkkZJb"H6U!Y6KU
+Nk+45PD6ZH)jpFcP8lbH!VeQl,*lXbcqh6(VIF,3-816dE-dM&Mkb`9MHXX-cj6!
+$kLm34SjcGCKb0RmfL2hMqc(DD&ekXp5TCTD%JI"%YGjMQhjaZDJ*4E[dZ&M*EV[
+&TNbhVd[JY0c4Skdar4-P9AJ65B80bmYJ-kL$FhaM5JL!9"E1I-iMf*'jj""Df*[
+LTKNih#QN!N5[M6ZPpV59+Qq&H4qV*841iPqTSD8#i#BiMUk0`G'(0NZ8@mLZj!3
++BmUS$a-,#45YfU2BjPB&mCp-i,&qPCp&ICe65cMfKeA9%"pTITTN1HP4R2Mf,YF
+[Ch)9#MNFp(i$mFJCIK`!Thl2L"f`IM+""6rAA(Cd-E@GaN06"Yk(NK(Z4)p,&,6
+N1+T*(&*Nk!NFlj*08-bAjU,r8S9'*-P0HKi!b'YlB6PH963fm"J+p[iM@Z-4NiN
+Eq+#2aVlpa',CNHjCcjcaM`[IIL*dB9`QhreNJ5lb3P&PUaZ+ZqJL!F('N!!`NTG
+mAUPld%Mj(YZLMe8q1N`QccmPRD9&q&#j!rPiR&BcjR+b(Bp0FR9`JRfXkQ`pBLX
+AZ&3-3XV2,`'hiN@3!&b`2$95@#2kU4VLIpfY1$ZeeVG[i&FVSpRRKB)EQH6fL*(
+$%N(jiN`TY86BfVESN!!!U)&`!S'iHdlRD8hSPG'M$dDrH[a2bRb`Mjm!Sc+bplH
+XUUM2fpp5LSfd-eX-,4RqDjAPb$)+(0pq5PVVlH6GqNU1mR(K9ff()Uq93l5[a9&
+XZc#!a-UiPQBUdGC[mm+)U$3BcKDlakE0DEbpTP1K!$U2ql@iq"QmQSKcG3LViCJ
+(q,Bd"2r&PPDV@@!T%MR!Y(IHqiEP#8edA%BTD6Ta*p"J9SReiK5bTdZN0dK"*C+
+'T`'E!PaHR'Zi0*rhNd8QXP"PMK6[YR$a1XZVG(HJX8@8ar)ECZSU'F1kHI#pArK
+G8Mb*Xk0Xi(@iAG2%k)U#Z'1lGe1Piq'M@3N+i3E3He-LpbK!f*qC(&e'41`+ifm
+a@j!!)`N1rkJIBrKYSSiiA%fI1"1q[UJSGrTLXNMLfRhAc"eEPI!B,h["-'Yil"&
+"FSBN&*ffb@GN+JfbaA'2CqZfm1Dij6b(&pIU4bdZ)!BeGk0!JD#edVmK%CqpU+,
+25%AN5rKY1Tb"+8b4pY-SD31`@f'!lHh(FF)mpNJHJCT3SS*iQ5MH1k4q6PFb)M#
+#D!LJkhk),jYM-9SDq20JcdZ('e-F4YlZ9UL5@IZZ'l5h'+P#Bm61Ma09T(+IqrN
+hJP,XDV!&`HNedk8m(1LYe*m0G+pp+H4f4Vj6JAcrrYa0d-"DQhcaR2Z-r468$UV
+-Mq'-$i1qqCGTpCATT@Uha3BL5aMj4qE8LZ0cH(e#ZqRfbYr"h34CdAikXC6GBQ(
+&p*X5+QRMf["MdB#(Teq%0"F4Y8IH#GY!Ib0lrq()&$-&S')h*a6,H[#@1&T(,`p
+RkTL65@,T(4M84q$$3qkbr$k(+ja-fHe-)@fERCBLN441e[$-*"FMKP,Vq"3[HSK
+L!)2UBU,ckZ($r1Z[frK$!rkSXe&%LEA0(aEm`LlUDHJ0XB9[Hj`DDUKU@dK--f&
+p6R+@1LPPii",jS"bFiT0ffp"CT+X3*S&k016(cAJ4f,U%p6KG$"[eY*FNYP[DqM
+eY@FE,&Gm[lZm4RmehG-MYD-%"*5+l89kUck4XUlXKc@C3V,J`im9&NT0c&5QkG3
+KC3,YhNB,P2(Q$J9-!45HQ`4!rcT4`d2*MM$1&IT2FUUpiNmfTrjI#mfprl'-i)1
+XP`0L%rl+TV$&(arc`Yip5D8a9G3j%e&+59&I4Fa-R2KIcY(4fpmhjh$NK$r1'f1
+#3FhQe-U2H[!)Z2P2@LQIV4j*&V[Dkff)U!'&&pYbIp)&cY(N'qemd9S8b@[b*Ap
+ZKke1ir)@pB9RQdSjpK@#fhe`Ep@EJpS)V@',560*hBYK"(Ab@aI`YZrD[F2blj6
+*kEX,a"0f!(%A0*H)J8Xjp8q-bB5DDl8ScQ3A&GL4LBDIc$mUi*ZVBN(`M1bY&fr
+Sd%HrJFkbJ0D[m(1%eiIDJIZ"TYB*6XX`'ad)`#mXCMdBjZ@ZJk5XE"eFmiT)U-a
+AjGK50TaaI#M1+9-3,Q&a8r%)Z#+I@`"L"MITm0c4aC&2%N*'YTbJSNT"R6MjddH
+a()$PN@qR)CDX8!8QaI!5!Sdl56MDYja820+YGdMmIMK2ASih*+#GBA#'2)J&6G8
+'dhNeC,cJfd4MSMT(jm$aH%2CUH548%f&IF+6k"Lm*$JEBqkk3UNA9LrB%F'USFd
+mqaX)-B&iZlDMrl'U$8aQV9U@qCZNr)Nmed5256TVR86$6@LLY#"#XfZI0YY'Z`1
+RN!$TB2ic,UiKe2-CE&%8Q+!!8fbN0d*QmV'dM3[YXH03i+rPq6F6pik%DMe!I6$
+f'eZT,KQjQ9r92i$34F!0PC+"0mFKr&lXemG@`rUPkXa15)"V&LFK9KDHG,%[1lb
+E*l,e,Yf6#b#d+$BLJ9Rk`AJ99*V@Slr0MX(K,j-p[hbQ-ULTq%26ES-BRE2E1Tr
+aABEhSPr3['$J`LkPBLXmd'If$3H8-rY5a,f'cV$LP!HYkm[p3#APLhVaJ4)Rd%*
+p"$D62Fcj$j%Yj`SlLRIII)RGDX(Mc5BSX@r+9LJN'4dple-p2XLJGZ'%5S1@E%I
+rZ$jpQ2Yid#rIBq'HE&8+-GSDakrP,)kLIp%m0KrdZ@[[hm0UR'!&Qj(2`B[@r(%
+k)X+a,92B,MGh)Q'5mdS!024q&GfCKGZpj6p,N!$5'JadcYq&!&E2KMkRSIY+,q9
+TTN[KAAZ)q!r4+T+5rr,R"@XLq(S&*DRhbQGZE8AV"@CGp%[52d6b3',``,)!@j!
+!0V#[UUT#dSAJ!8D,c+eKDIm"%Ccf@j[MLJ'T+3iUV8pc(!9ClIqNJ0'c#*Xph80
+$5%QRIAdG+[KffF*+hTD@1#HS2S+A06!(&bhlh%2S%Ue,$68T[Q*q60iak`F#6fU
+(i,D'Sff-0'"r!6AcmUF[i[A&bVZHjrGKN!#GcGeK10pLd5qI#j8j25,F"1XS3kE
+eL3RY8iMIXi'5diHX-r%kc1[@*Gl+iqE+0CVXU4940-1G-kG"a-5Ri5%X`rZ9SmC
+NP++1cBR[EQe,)faN8dGr29GTkij@+hEm-jZli@058'@TU$ql!P,&Rl%pSI9*X+Y
+',q5!$$`@+hP1Q%)VcVA94'r+jXK*cZal&55)UlS41T1KTb35"DD9A%ZQ%@CYQf6
+CLQ5m2-HUqQ2VUm-1!r3m8&D"T5QH[Bd*,@"+-`i4@T)+jF0mfH3K,Y)!eXiEdjU
+2,Qq%e%EpK86NRfe-X6#BVL8)8G)f1jFe6APK-NrZfGB+EST!'$elC9b"E`J4Q+B
+(*BC-p#VS@G4%cX'H3C,G@N6&Lj@j-KBLYVI4A9e+-V"UU@qKkr`ik&j&"(&8$""
+MVNjj5+k'[r&,RXEl`YcPe35B#40kDp(S9'@*hIJpEM@VM3`+bUFJb*m5IZr%@V!
+ahT4'p33I5063-Kk%r#6&1C`aD!e!h5a'N!!-9!0S1dbEh#CM2MRlBrEQeC66EKh
+I!bZjJ'mh("KY(@0,"hZcJUj`mjbAA0$D(@4jP5piU'IJ6,Z)#,3JS6kA&FKhR"B
+XAZ9FPe2SE3QBFBNXa#1Bh,CNP0&3aH$!jPAlRFElc#(P4"HR3-IC#KmTMS$'`6c
+-$%b`-+K[jLBGGbM+pPf0Y0NSd9JH%aXJ3F!&L3(R,LS3!-"M,p,*C[B%`@G+D&I
+GZ%0,+2X,@2V38DYl3JZ,C"2BP["-Ebp[2iQU4rAjER&U(N2Ni8AM&+@V4$8jc[G
+S3(2D$%&+Fr,r-1JrNmDd!8*Y(TC1BYGXplV)"81@!-2rf(TfZ5V8D5K)TB53!,m
+i$#k`%beh2KdkAf9le%9Vr[*+0UP0dEVJ0cU3!*b3!,3@RflU!RFl%k&q-q["pBI
+)a0X6`bDffF5&#eVN%&!d'!`(E@H*B)hJFji8M!SHrMU8Z[13!%%al8rENS56K5K
+PR'LCJ)hXBd#f)"1irID205bD*eY@(0T(FM43Hh,JaZdd%18ce9Vl"8IG$Ip@Bfr
+elL4T+DpITHPm4YEM%b9aFT!!2P$Hf#M5D4MML6I"q"6qc`FZk%Pb-rNq,`I3%c@
+h2E#N(B$%2rqdL+2(k!Rj4kh4XSY8"P%kbfXd,lJ$0cMU$l"KN`pkkcjfQHK&XI`
+q6*ZCTXDGqF$PXjJP)4hT*KLl)GZ684G$RR[3"3@JM&"ClS'H3%$fVl39,LEr1+c
+l)[5ielE1#R8T#4NkRFXTQ*F)QLS&15Y&"X!%Qkfd,BXMJFXCk8ilC5Hrr,E4l2N
+bPM#e[N4)ZT+ckF&Ibf4l9AA@eQGdb9%XdZ+llb4H-'PU3%jHZP8r$fZ98mHifq,
+Ze(SajXiF1@QV#e03KM8&YMQbp$-lmeTE*Fm6r*05NTf'%BV5SqHBAF'rX0@S#*C
+p!X!'HE%MhM$IZ)L6iM"h9q(-H"40Y&Q2Ni8bX+'pCa"VE3MG@ll$JL)-VV!Rm+1
+)-pfah2bQUIjfG!2PQlCG4DLFaXE@b6@%`$9aY*fRF*RMQ+"``-4+rBRG6`8EUNA
+bL9iZN!"J%4LRhJl8CP+KAFKC$UN!(ZXi9qKJjNlk@&`em81P@j[*j1@rJmbm-+@
+3"!%!!$X!!,5L65qeGBAr!!!-'3!!PH8!N!0b!![SI`!&#9X!!%)U!*!%$`"8De0
+SC@aXFbl2J!!!Pla069"b3eG*43%!N!q!!*!(3X(8S*!!Y%a2I-kFV6a*Y'X#4(J
+R0d*)'rSKITXT&EPD($3fCQV(ikr&pY9"D8emB,j9ld,e&VZ'l2pC3I*K0($E5-A
+4Mp)V$3XJ0)K$dQi-!qbf+bTV-Xrd!Ie1c#h`N!!$mM`E*,K8F6K1,BqHqqX16Z#
+mbUeEc'%kAjq90e`*B!fSESbdMjDe84rSjBX48`qJ@@ME)jjCDcq2rXYe!d6fff%
+TLERr3&$#T@TcH455U25*#QGFLTfPI5rDZFYC'fB+rQBHeKZ#eGRDlfmYi9LNB+B
+d"$pIP@[9L($i@c#N%@rA%-H2Y9p814'Q`4Chp$%3DRTH+bLSa1mhQDh!AUp#bLl
+j(TmKkHU3!$DHX(j9()QX%1$E,Kk[XJ1CV%%pC[&hCVe1JV'0lVQUK-RAUkBbr@G
+9j`M6m[Nq4d+jS3GJ#U@aG`5I5Zhjr5(,G'`CEmrk(d+6AP$3c[eK#ql*)c5&f44
+0%,GbFAiU[L09&%!Qq'RpLq0ZcAKFB*5M-JHSY1C,L&Fd'hN@2R%PAfUQdrh,!m[
+9(dpKh"a`mLXa#i$QD24ZpjYFaBEL8%IZH8!1YciPQKKVref,q*H#qpElpJM-r&E
+T!-1V-GH'Dm3TZmVZY%f@G+H%KZ'qA%%jPfZXh@BiVV[P,B9I@!L!N@D`AN*Tc(p
+4PD1P1iRep926618$6X42NS,hce"135"1bjQ1K4f"LRId2,FfeBLX@C231A-qKDE
+h0k+kJ@"a+,#"!i10Uja9Re88@9NMC6$,*+*mdYF(H[r9*-0KS('f98JVU$-ALSi
+PRb!VepS1MZQ0+&HCM@PVl2B@F+Z#q&AT'jU(Z6Vq3AVB,TXNM46%XFf+@[S8fiE
+3-BC#!qqr`0JA%kBAmiFL93K1l[-[JhZX*!R@$RG*"kmQ@MI$6!I@1-5fm1HlV[A
+[Gl'#S@NV%UqTfS["VADd"B1JV)#J#kq5cT!!Y5HQ("Gjc*Dj8D#NX@`S`B(h1T@
+QH4+N$p)!1Rl'qcqjS1LM3l(1TK&02U2K5bA`r!bKqBFdKQmFhmi()HKCTKKB816
+qFAZaQedcAc'9fPVQ9X!ESIl`YJ`Q8CVXfa$DerN1`m"l)R",)M0AKDlH6XKjZb4
+'%a$@`T29b910#Q)K'cLTC+9!X8Ai`4FDGM(RLrkmVb+bmSEk5I8p"hc0)(C(Hmp
+3RcrZAPaN4UT@qSAX[EJ!FSP3S,pNVD4C-&dRSEk6,SqES![q1RbU)qLCFch%L($
+QcR@[3P$04!)lbjQlZM1,5G%IERXr2mfZAa#EUp+[)E'q6q2Qr9aKr2@X-D$L16-
+E2'e8i9Ij"+C5YlJfh5lCBlJZQmc*1Zlk$`4GlQch```C9IJ%B5*B'YJb98dr'@d
+bX&`&Rd)&,U%9jF@qQk#5$-F"b!FY+"&cpI$rYqIDSiMfab8VmeTR0b*Ilp&6i*1
+q`2FaYZZM1N6("iFm)m`PA)QDSNS2j6b"BU3b0KDbC%rD@kH-m(jTfcjhMKVcF6%
+k(G4jM,PEGEN'[a`l-&VHZ%$IbEEr#N-rF!YUFlR&,dGLbh,G3YYqG`Gl4VU,l((
+D-1dE-YRDNjVTT5GAF8QE9a&,&()aS&L%HHQSUa("03+NiTS#NABH,+6#@JI3+Sb
+QcphKCaPH+[89!TPjXk$i#VNFcj9abNX[ZYq`pd(EC@Qi+H20P`Dp3ihPVNGDph+
+3!$*r!f$&26$N5N6rH#p6@TdJ'#+T0#Gcb4QC$`f3!,bM2U&(F5Ca'-dVp[,J`R1
+"A@RbU)4XKI5*K`aNZ`1c+R2L'HV"Ec$$jPh%#E"pf5!Z[DSbE)I9E0DJ0URU*4r
+iJBh[r"-he4($'pBiD!pYY@8pVUj1a"p6jf1K*i+Fa`aJQAN(b+[@bNY$PV`$Hj!
+!!MQ,(,ClSq2*U,%ZN!#`+*m)eG(Ne6SHRbZ++P1EY!2l&&(-*IqQ8!d!,1jXNSI
+Kk)U@V"4,N!$RDUXH%@"R3XEjJ#Z*(F&fk"TDLjqm5U#NEQUcBd*9jI$$-$!cJ#0
+GMZiP@VI!@Si4amC5KdTBedCc+1k!L-"a&e2VH6[drFb0f9X%,HCbXd,PZH(l&Dp
+*Zb-p`Aq,GAQ(R1qTP6jPX@NIK4`lSlEel`1+!J)&eEM9Ei)IqdQkp[IZ[16m2Cb
+0VJNL-!2AIUr2#DlS$baHHAb+%XI9SkDrCa3GhQ#NCU,YQH2'i-Dj3RNdPRH2G$!
+1Rh4*V[,9-U-!U69XSRZjU$a,NErhe`eD3!,UD#SmKTUd$MZbZK+-jXN$JE6CR)a
+LlLThf%pES*m"2k#EC!%4JR5Vq8!K6Mk+er`ZQUC98TI1HPbqFZqL23K%J`rHV`X
+RjmFcGPLd$X3e6irq@aP2FPrr8D&M((#3!*c'aR`HehKCD+9XLbK%2'2P!d,3lAK
+(*J%hU"$8Ld3Y,Pdm9e,FrXQ[9k8(K*Li@rYQ'k4*h06C+h+qk$q96Pd06ZiHb`#
+fIQAUQID1lKHpaj8Kh`h,mjqR!i3G!86CUV5(S50Td8HRpPPX,8Qk,e[[4M(%K4l
+h69lD"IJ'3kRCBhqGj2ldRb&J"r29HCP0pLc@,NCZ@UL+qk3TZ1PYe,[k`YXZB#A
+G6Q5hbY[ZTiSm+TcS[)14BHZNF+Y&j@mAIkd$P)FLU%cLaS#CZiR!5"0X2ZXPeIC
+d&`8`Gj0m'rL8l4C+G,i85$`rfYBGPHahciAF6e1b(UmaDaDKS9$9@2$@NZPQY#e
+968e@PX!e6e0abT5Ym25BcP`"A1X@G`0$D13TrjeHKPU'-$41ENLji!Q6+*H8hFY
+%[FZX8!LBhNkK'bqN9Ga1qVG$kXYhKY88@i)e5JEXYfrq*PdpU2mA(qP9kIpl2(P
+QRV"3'5!`f*V3(66eG[XbHFeLZ,-%*4p944F*B!jYe-2R@,j-9LD*R&pALD,%$M4
+228*$hhj6(2CCE-,`EG)k5-YFAQbT%h`MQ'QYmBrm"m%6$6)0kDVEd"heQ)Y86l)
+ZLfJeNQ!MrMUm,+YTNQbV24pC6+m11j)M9ce-,$R",)X4!5"N&GDPdrGUh3P,cS@
+)bB2GGTK$aG%SeHVhEJNCfhGHb$G&QRTdY,XB+82PZU)k%EHI94qqG2R5IjUSdV!
+l[HCR6Q&0ker6F1E0kpXJ8RDCJ%B#I(5S+*LrKJRm4fQ'JHV)kBERPkh&E$#"DU2
+1iSaAHkG2A@eK'H9SR61YXJ-+aKcUbY(H(QCR9cm@MPU@RpH-4@V[peKKHTlh4Zr
+*+aK[`3YcZ[k!&4%mfT8I`EhQc+%'G80cZUrlijrAk9U@A-E8e3fU#R%b*(j0`Mb
+klC4Bf!cKp()b$IjAFBSPcRe#Pr&KiqE6dDaT"CqeZ2)lbqpDLZHS@iNFKG3LiZU
+P5Q'V*c-!"r[rp9K)""VF,NP['MGcB`(JlrkFKEh'SR[0@6Hiam0Tj0HBHbEj-I"
+mrS&KND66jXbJBNTqDR'Xh#Jq&i@br#[Iim4KQ0[e-a##8P9-(dbSHr(*pHS[Ra,
+61+2fLEaEBTJ@5p6@VLa)q(Z3!(h,Z2Fq!BE$kRV"Cqa@TrqceeFrH8maJZE"pUV
+S$LfYLB@C"%`d%m8ckXMYpR[jKhdKeJ@P@[UVl`YDNkZec%12aL3eFfhX4IG89[Y
+CY**$Ac&#ae+U08['"SqDc6Pr#X"c2r&U'e#ePc1eicfG@5!M-"PjpdTr(@H#P"c
+eE8-A`%0C2&9L#E(888+d"%-m3A!N'aKl!1ND3jB&HCabLCHb1-UK2IFceF'1A$@
+XZfF0!YqF)fl`[RR&++NLUDTChRcXT%lQDVf8p"CBCXNhb&R`hrGV%6eYc+"Icc6
+rcJC!k0)V1(M2IYjpPcC`p6m[1[HZ)EqdUMAA2mN)%hap$bP0RP)LT%k8GpY4Y2I
+EJKlYH4C"RZj#)AkFF&RlNrJjiB81X#e8*fB8DE'fa`D1ijJZTB6HbGXaEl9ZKhK
+a1HXVT5i2kM'KDfd[*l5`5dfA5B0[i'e$V9lK,L#G))'G$4GBFI9GqE%r"i&&YAK
+c[frc8l&LZjcPdL2FK#66rcGh$Yp2"3H$*pT42UFK&lp,ZJ&MFE5b2jC(E$YFV-G
+Z%E4fLCHFUARAde5ijb#3!2d"V,L'DpJlf#@2[C1a#lMp@bQ1[5(fVp(,XhdhCFl
+2aYC$Nf0V`ij!5b!)DiS5q@felVMXQ8&4``#SR0iBq*U6hFQaZd['RlZ*UI6623@
+`TTC93(0f@T[HKkY'kE-A)0KV"B6V+fqFlK2i!e$U,AQJS#Hr[bf'kS#aX$,1+3S
+0rS3R16TDr*!!5paqr$P!VF`*M+Gi$MQpYSa)QU9b8ab!`FbZ3#Mr,kh0mjh$*YG
+cr!&fK0L@09"T6%91NbBM$Qd`!E`rCRl!pGQC68'cb)C46pCC1@[RZ$MrLQA'Z!@
+Lp(VqYIIPCGYQMZ@la"eQiR0(6fBY)0iF0Qr@6A)Qr1%ekSZ!2rFqj&"e8RLTcA4
+Z1RM9&mXbc9#pT+V$,D64%0GaA8(,U+$kaGh+%#FLR#*MVa"f%%rC[GRF5!XCT+Z
+`XP+C1K+BHEie,,VrPX%-cY(Zj0[pIfNFN!"JDD'RG5mf!eXP&MmmqBDP@6N!M5A
+Ck!A-Z#bRf@m@qYp1dN)F*iV+BM6`(6`j33k[,#p,kcq@%EDVIb(Xqlqqi@59FNq
+K3-AkL'r34%2dMqf,Zqm0i&FmM-"Y3J8JJ[fCFN`0,A8FFm`q#MKKIY1aSb)-0fl
+$#AJ2If+i$$P&UK[e6-VbMVkrTmclUj[PI!"Iq5iQM1KL,KHYJdeeJ%*q#T&PU`+
+JXLHb'ZS4HPDrZ@Z`2q(b'j4K04H@FU%c3pjPTeV59ILL&bG#J8F&RR1+EB!jljA
+(plq3!*-*Z$SfY$q'e`bq9+dcJ'pr"ZUQckc*dF6!f$fk&c!jf-'90BEV"MQG8['
+NI&c0[*fKFVM'ZiXiB('k8PNXT9k(-p%(U+ceDT)L+G)`&hB-)&pEVBRLPR96cb[
+UjXC0%DRH@ME0hfUL!8@ifeb0#i6k@aP3j!'r69"cj9NYLkdb&fl1SYZbl9BI5('
+'42"cdD2Xl)fURYGcjimN-K%HT+f6c5JSP&8,h!)iX4Tbr28k$K16&%9G8NTa39P
+fr9-`I-5Z$qVa&QmLF`PPGEqkqHH62)E53Na%RFf``4&M2m[-S`4ADV(2`kAKq21
+F$&,lC2!"FETX-Kk,4'XH[[)'42mfmNLGbb5H)Q4TjFcGqmPC)%T1IVHR`k4b3Mi
+15+%BdaB'8QRF!E15$1d2Kp2b@eM)2dXmSC5AJGX`YCk@kGZ+HJ`(,9H0L"deTPI
+L9Q!VRV&C,R,b*FA[C5ZBhZQY%"i4[IRGm*!!5,0Q`j+br'M+'(l4V4+kmD%aKPq
+IG@4jGeeM01[qE,$klMHipZ31AR4NCHXpb@BdDf(XLSZp81Vl8F8**"-RTrENNaj
++kqDI`Yb3!(IH++F5LCFIq8E%FJCN3jIc'Sm6XDK%!bmCdXF"XD"SjU[H9Y)2`0e
+&S,2Fi&9)YJeEk,-a''rVlBH%`A"%'$IX&!Ip1IelPE1"26bQEJGCh3Qcj%pSFYX
+E'$A0-T@,X#K#eC&qK328j1`8F#6'm#40SeZRm%MBB0Nb6k(kraC*L4Ce'-RM$e2
+II&ka`-3!`De1K+[H$9$p@@p`"9c9,)$-M3ibPjFENjeV5V2p*FN#e6N-YB9kK!d
+bMCjJ%[),[`KJIL-H`"F&KpJck)41hVZV`!hfJTN4r@8GFi"6`&jfmmkY2N$DYeT
+!qNrb4hSN5!%8TSVmFHC@lAHR3LF04)p&-S))J0+@&jNdR(13!+m!YZalkNjf,Zi
+`i8hJS5I'8MkT(1!lI$l-f3VmXSmhiTR+5Yhf5@A2KdeECP*kI)FAPBJ5&QM**Qe
+cU'"f!QX(8c+k@4#Aqi0IMN5j0ZBaQ@kJ`0L'Pac@C3A5eEaJ(XXBTipqLpCFGBL
+aB4qMFDhK#(KC!)A9@35U5SbMeA,`PFDY%9F%j#J8[N-(HL"hKJL(Z3S[4I#14H)
+6J'64$K#DUQ%%F`J1(S8MYYCQPF'lGS%i$Y+rV@V$%R,VD`9#bmGIGj,h3F50J`3
+cUMkb(N&GP(d3IfDKqal))mmKhmFp1r(`P"-!)@+%506MG,0"p,%UG`feP&1aNiR
+Dj4'I9Tj4(`5$CZ%IbRd4$h"3Lrfjh+Tr)MiCaVH)Qe#YKm%I"V$'kLaRYEA5`SH
+Z2++A'!CiArerFC`BGiRFM[D-)EBH0UCB&I-T9VpDET9cUmL%)[%$FX&*#acXS*D
+AS0UB'+#[iCD$UHr*)bBUr&eriZ+hrU#Pj[9p&JHa-Y,*UrIAH$e*3H*j"MM-b0e
+[m1rD*q4@98!1eQ%AJQMcLp&4)83BMrL1320pNS2`5VAXTmKFejKFGjc[NTR9hQ'
+edl1H+p`pXP$Q(5rG,-9!lIJT9T)mAa)VCak#R%V+%U0!IH'Hj1IPZ,22`MQfbi'
+0S33A%%e8kkMRGY+J4-G`ZK$ALP"[9Jkpp9fZa,JPhG[MhlMPI#FjS$X&X'"-,aq
+61lAbqqD'Tk5@I)LN4HN3B**H4LUEG`Q$PQAc,)Q2Ui[CAkPmRKeTUa6[R!MTlG'
+4RQZ28TbCj12V#1rScYAk'SPUXY+`KULDTi'%kUPiX(TK@!X*Y'`8!RMrk$)Em*F
+8G@FKF$k$HD*#"#@kN!"IMRG&lC!!B$pSFjA9X1iEG+G!qA*UBrZKcTG*CcKD&G"
+9SeBb3BEa,0BF0i9GkY6$Xj!!``ClHUU0i1JbZE6Y'JISk1`Ykbf0-50YmYaiHbm
+kSrT[Ef6aHCQRYY%,qZ*+cA6F5YQai6[+p!Kiq+36Xjq@5frLdXTe1A@AHI0B8FU
+49'8pcp!IS04mHZ'&+i'V4YA(I@BC*N-61hB[I--(&ph[ae9G2fY#4H'-p6LRY1D
+H@hK)0!F)8%34"h&Lj0Yj#XNqZ1Lq""hf#Ii$N!"PjjVqHaK9N6RdkJ'KQqdi4QD
+"[X@T2fV&*PjKj[NA3Ka**8`'FMQT(rrHVcj[%8KN*B(,9V(*Y3(dU5#[l"+r5QH
+h-klS04ARD)-qP3f[1!LR)2pca!((%8fMrm0%-SY&D)5@APh)!2d$EJ1j%'ra`8,
+QqjMp"2"RC$@9QLai',fC)4l69fPl@cM9Kq$"AHRmk$eA,fdT8DTj&8AG'NPf1Jj
+0Rl&2E8P)E0J$hUL-Qapj6SQdcCIc)Lar[2CdVlGH%H8Lpf2*`P6TRXfmeRI#+YZ
+0(L8eqJ%$8SG)!"YLIJ42M-BFkJ#j`16@H'dh56-PAS'[L,jYJDr+24(0ZX(3,Y!
+HjZN60IdKGe@Aai`*CScDNr%63I4$-Rrf8JV`%rkrBT%B%2-'0141V,bj,d3#H'K
+US-Y@*Jb*F-XaUI[`3-1$K*FJG-ipq5hqMp84lD8"6aII13'Ml'elQ43Nd8Q3!-5
+lAT'fAB838jVX1$@clDpSCl$+)%&R,[@,eJc52p#+XiPD)`I!VjJP6TX0lh&3l#j
+N5E*E5CfZ,iJFc&L9!`lpH!DaN!"UI`L2q'!DV22%%b1@5C)a()dc9V-P!DP!j$I
+MTrc)pUYF#D(S1CYT*r`X08[(`F,k'm9meGCA+L49)"G1!M6j6f@NbfFqQKF(kRU
+dHTQ4Q@I`aDeMrJ'`fAHE"#-Lk!CKHDi#EU5J*pG(kE!LFBp(U(JQXQXN'SkTD4b
+%F9+61Q5HqFe+*EE$U&jTRPFa0I"G@i%@aK%Gf1aT$6$X8h,6k3Q0-hTK#`%)MKp
+&2%YEE1YM$klrdhCPEmF(PDNHe9)'@bK&UUl2#,1*8r'TC0X2Nl$0*RFD6#X$f%D
+j'Y-Mq0%'ARDq)BF)HmH@Q01PNe`rSe3hKd$C(GkQ,eJiSrSQ((PYA@MK-8ii`3X
+'UZj3%BBMBBKrA)mEaSBj+k3Bf`-Lbd-3@UTiMVZ!-l$#4Q@#(M"Z`8$8ee%A-,"
+"aqFa"2MF$46JSN%EFNrF$QHS!a3'Dd$BVcNV*S3LiNlND1(dm%8&NpX#'0#rE&)
+&m48,V4S-1XSYHB[aqGRSqR6E8MkG8J0Q-RKXMlq,ZQ"$M"qA$Z&dGTBV$lFX@#Y
+PUc4&eleV!JHjkarh,QYDC%H[!`[cF$,IFe%jaRUC@kTUQHT-l-j94S,FllbLM3J
+rPK4Q"5Mf+rD$`**,%@"m$ZLl*F2TZ(T5H`CRF,epar*m!DF[#aRfNGHpZ1i1!8,
+QCX0heRQ6&kE%DQ,Je,K!C#4bkK,2mab,`(RN+@Ap'#$5`Z4"reP",@Fi!rjaCC@
+Z'#KaCl$A"cV%YHJD)FYJ3N+93&PJQBAdLZ2D$)1Plj8c%hG154Xc&'URLYmlj99
+*'RN$6NZ4i)#BF#YZ$fEPkY%Z@48lr4GQMlZk12(VHfI18DEbY9LU[CmT!JF3jYR
+%!BI,EBejLiCHN5SMaEV1Hd(N5ElmJRLk110i#qc"(4#e&BEfG(6"ImaNdKbdI,G
+aFRVkSQ45HB(Vk"2SK@6BITYGEk5RHQqTp()J`mK-U63k!ULV5BbFAQVN[T)FiPK
++RJXpMCG%ZCp18Qd!DjS8TU)I4IK`@R3NTCi&RdF`EhqGSqhjl'jYH62V34ePK)`
+!3,UJU6mjhkU8jYXUiX$,I40fK)"66))Y,Z5-9*XN,0G'!hB6LJkYT!H+[C%V&lh
+EHi*FQX*l*8U)-Z1$Lb&HkG5(aBZVHpiZ%'(Hf*pPNc[BCX'l&jk%J!5bP)!R*EN
+JMpIe8-QI)!Ta-AjN#M"r3UlI8TNPh8p+DKi%i4j#3FX'5k@%+EMp%SJdrAqbhhA
+'ZISL0*d"D+T)@*0lE9@*Kk'`DpIdB3Lj"c(lAlC#Q1IH#QTVKGQ&&4dFQH3k,)R
+h4'*D`Q'RY5qN[kQRR%e4J5[PiAqR$Gqc*iTGh6f2MlR[DXaJ2[Z`Q,#l-+NQ4HV
+mV3iX4$a'dJ"Z5$23UFf&+2dRpIp'$6&LY%P#8dKj'#8!SU9`JZiF#R+-`J1IAHJ
+qBck",beeq[&"RLV-mQei5*!!NG+M-FZJNJV1P`FjBZd06LKZ&(mM@0S#biYJfL,
+Im)XThjbSqS9#%aAc,c-"(pS3'a3a*(HL[,j60lQHBYKIdri0,ih,(XiX[S,jQ%f
+aqbck88'GC9L4LbDN"-`"YBAVSfa5`a$06@kXQ!eTSdp2LlVS(8%`FG8Ep19fqkX
+qHPNA3SqA*MMIV&*C"&h@GPf$m![QL95RhPQPB`A8$VCAdGaXNFSaA"3P0Y'eSjI
+ffe#6i+Y1mF@*H5E[8$j8HRU,3kPbPR6&pQH!E1QZ',mpQd"'cY&hfdJ0,fj!(`E
+`c$c,lE%3TJ`9aYPHD-)mGMU!,!-,%9"IPLED5@QUY3,j,k"eBSE['J1DiY*Fpq%
+f8bfS+#XF"c1f!JAB$+MD3pD3!"NSPi)'V+Af2cGkmIi-aJ0#,9R#@f5L#M9i8UP
+ecja"cUNJ!R334G@*ChmBJ[,CM9Rp$P%0#b*[E3T8k@*PIliUm2l4QrYNqm%SldZ
+djm`e9,R)hBkFN!$`rE$F8"d[1lFV*fY*$,+i3fpK!2k2f-l$9X88A0Tr)VbPZqP
+d#GCf['IR0C(B[jB!3X4d"f-[,Z[$Xpa+Ec(SGEmhh,C59lQd0Hq5*BeI'K$a@&$
+Ul1@-4jLahhQDJ`epJcAY!5,LI@ZGK*8hG)JXJJreh'N0)eDJ01V3S!4*E1&9&II
+,,SKbdLE&*ZfSC+9!LM@Q)c[DK1PVc'H)"P#@,H[e-YEDTS2F`HUq#Q#UZ*a'@p*
+Y-@VCXYdr(c*2HJeIY2rM%LMQ&VbUdX58*Q"k[XJK6ZQ2icEE*G"$2R2L[(3CIh5
+IXTX)k6kTfQ9S)*p[(SEP1cG-CkRP(p#6j"&4JQAmJ`C09*IF'V9Kj3QYK!'5A0j
+8%e`m1D@rlr*+eiC,fF#MDElh+4#[%Y!B9[L##YfL"aibM*br(!1Udj-Ff%`!V+T
+q5I"RX'#cNe,4SA#bK)`SfJE6MEXlX5jRk@YV68GDH5*%,%),LH2G19Yl(r*D#SL
+![k1Q@TL"9kpi0j1q',&MaS1"`V"3VJa'Z"*8E"`q&%F)0C6@elC"8Bfmc,Yrje#
+3!#'NQ9$ehC)d&EGZ9VCPkjPIY`4i2U6L*F8iM3I8dN9@YK4P#X#B@P-,8hA-k'F
+`NPJk3C!!q5e[kXjU'[hHIfh*ZT,-%dh'"p#ZcNPeJ1p(THrmUp)1f!,08'JFqf5
+Rr5hh1adl,CBNV`!p"NGdVR,cA'dE(N,Xe608(9QQAjY+UZ)EL0pr4'A2cp&IJ8D
+Vci+[5KRTXS@25b2`F-@4e0%lJ"'%S"+9adq2MFEdMa8ElbZ9ZT4cLbjE$9`65*M
+-S-Xdj-FX"(8YQG@JqM%@kqBL"P)CZP-T,VJT%Ji1J"D@-ASHN6e,*J!f05j2!k+
+UEk%9AV[(%TD#S42L%Fff+q%ipf[%31r[@dl2q$U*m,'L([(H@JZ%qN%,+6QS*&P
+(#!$6c*9ElKNMEDZJTfhEd+EDaLjT8@UBCijMq$e&,l#c-2-X$V0hi)Z18ppfXrp
+kiCk+Hlh)DcMMaX)d''K[jqmB`cTcclmEm&K(*Afh6@d)6MP-SeTEIXJlb9DpFE0
+'GGr-4r[bDY!BNeCT'1rcLZP3Fl"BU55B0QVIiE8&EZ&%hHEIX$1-V'pVX0F$#5(
+@ha2%eD54X1UfriE"fZjjcf#-@Q%YDpIYYIr%MjdZ83'FT#R3rZ%VV5SZV)r['iJ
+,Q5")Vm$D*%-&#6`e,8bS,[H9B)CTA`EF`J9'R#HjP2lJYMNR4Y2,BT3(Ir`G9dl
+19@dZ@r*b"m'PKCEk8b9IhehGpDZap1YXKMV,AM+Td#K,8@a*rpSIp08efp%S)e8
+dq(MjY$LF8GBp6i6@1cJm[!dLD*)p84ialT,#CN*0((j"Fb116h,-cj4em(`9hH&
+,Y6#!)iA`fGa`YKfAMc@E6%&ipM0F$(I(P&BP0qrBbe4br*L[JRG#U`,Dp9mP4rB
+!8J5E$Z@#B#Yi2bJeeRdp6JmT"Jii[IPX4)(YVF6f3!b6V`a"K9`J[K68LcLX42J
+5H)G3&,PbZ03,9HTqr,lC!8U&UfP2b`*Y+)`l$H-e(lGL1P*[bZ3Da@*G@hlKm%V
+Q5$%fHd+)T2*r1,!aS2-HC`+)pilc02#6Z@`KXh[9`PUj8NmRlF3Q%LkSV-TGNkD
+4%-JZ0%!UAilR)DhFPjX!&5pTk%DM9NN"r"1qVR2bqdG83"je(%Tm9rFL@Vhim5!
+9HZ$(Ge!%@#JNd'a3[H60X5(B$4JT0V)3R8jTh0b"i2P'df[5'1ae"J`m*pRkkF!
+S#!AF9'kU'Fcbr&qrA830NN%3!89p)i-IR)CECCEcV5YdPT,89rNKhRGG@%RjM'3
+-rpJYDD1G1TpUXrSNiR(*dZUE9T&(mPP!hlcjHQ*"r3BJlcQ85RV@9UYHUDdMe(e
+k1be2*0R'KR'q(KBd'EHUUT&+-5hRLQ4[r*aaV#Q5"S8AXh#RKX$LVACdN4D4b0Y
+G"heY+2Lj3(UbK6,"hQDmGf+'RDFr2a,03"D`mRDq[eVG""$**99LI1BlF9hF22$
+K(SQjUeFY4$ebZF*5TDU2"b$kIdX!)K@Ijffc%RJ@lq2kNmLCPaG[ZL9)F5dN"j!
+!Gi["XeG&#&fVRB`-T%VD,L"E`c-ka8pJeGQa4b!EkD6aATL#%B#$1Kk@2[2cCA6
+8([qX+-$q,DRNLklmM4'Lp$SYL`U0&edYb5`DRh'JArPC@ei6C*SkL5Er6d(bJ-)
+l5*J6iBMpUNL!dDf0[LQNjb0A#bBS$&DBG4ECpF'bV1D0p`)5"E&+HGF$2S9m"')
+N%U4V6@fF%YZ(NZJ0A(VliZAF!@cY9l&mM*!!la[GCKi#LlGI3#e%"V9)[ma@KG1
+0%V&f9*c8UbbDE4+e)(#f'2$I"M*GM-q#X+"+",,02MekTT5%Q2mqkMHaH1J&%)B
+rcl*#N!$a8NH5!2m&2UI#XL3VP2ap$FM4cK48B'CG-'U5RM2e1J0+AVY[b"8M9*J
+4!H&GkT09N`!5P5rf2CXDj)@BG1@#X'%!Z)ZA5V'dl@kifDQIK48cEd58Jrlbr+,
+pmdm#DfkU9Rfa`$E2f`Dd8IEfXAD`iP!ebCJE*jB8bAh,#rUD9,NY%eGE"a53!,E
++"8I4DbUUl$"F"k&-X,CcD-$c5$2hN3[D!YbE3XHdmBj5+BFL0-@&13K-CpC"pNC
+%d4RfG4'60raI,&N)JcEiQQPbZ-rF,dmE!EXXGFlSKmf4VL'kIXLSF)iqI0X1AVA
+0emlN*dAcD'NQGq*'3fS8XJQkdhXDd)H*P08X4!9de88Cj(8YXE4A+F0BS$jdaGY
+E9*XebAa38DfTpp&XkFEDGR+f!3!V%XkS&i-!(PEl1q,XePc@5N)+XZ@M)'Y1,-a
+8pl$iTIj@IITZEmRH(I"lYD1pjQ%LYUaB5QUIhb[LTa*@9bj,!qUlh88Dp0`f0Gl
+SJTRiL[-@bMpceDV2feee1GA2I6q9"S,1DTS4I[&"P64$VeN'VAh!kF#+NF["*K&
+BCU9+S8@''8fCT6@EAf[crp,HL)kP4%AT1DhhAjaH8'YSdh*A+'NK*e1(6r"b%)e
+l"qA08-iV"+'"k)KL9p-$pHJ@)--qEG#GpYdqLE6C(`1,6h6DH+N"0lB98SKP502
+,EZ6!bYl13*(ShkFhJMq#9%Nej58+(0p5!,rS9Y"e+G11qa)%0[kSj&BdR$5$P2,
+!LC4!%-2mVEkDcmU$mBTd@*3ih8"&&'Q8Y&%kCNUAG#lJGqSNQE5[HkCJE)F+PQL
+63+H['DLA,V6"JSS9AZq'Ir**A9P!`k56,%[T,,Sj$E[AYp*iY9*c5MAMMa'MMK`
+1`AB,cM`c%@F1TJJpd$D$GBCJTU(MDTSJCfMMXBYLL"hFL+bQ3[d0l,Q)QaR-L5G
+'"9&VN!"D1VQ[Q8d9%TPb29eDHD+`1Vc!FEm,*D9L'R$i6Z'qQ6mj+qCVUGG%Q%d
+,I!,cfrhJbmmBZ@2EdEpT6$X`@h%cXZ0EUkfVe[!I3+GjlL0c463hEpl8qP"Z1h"
+T8h0kYU6S)ZV`ELK@G,QQF(9cUeYTPXTeH08M"UpqNj@Y&a+c!cG#4J#6YCCmZY[
+3a-iY"khjmfEZqR[qcb&"c*8XjLrQNeMhREe(d@V-PKR!p14bNDS`pRlIp(+CIl5
+bY$S'p43(Yb!HIqIQdF"Ra`0h[b"-cJU**%&[ClU(8Ekcl1M$9b0ANI68IiJfqJ@
+PAeY2Za$EJYkmCT'!2Qil[XFAPE,BK#YdC,[A"r4@ISfGb3m8bfqPA6#CI&R)hAG
+C0-N`Pq-LN!#eSrBZ!Fe[erA)62L!ITSlr9@P*#B(643)m2'80q!6ekSGU,#)mjF
+Xlm8EXDIa)PQ"5MGK%NBSH9A$eha@i-XfX5j-qQ![4B9i0fS&42LY'KeIdEDaI3L
+hIGBcVN88@IM!SY0ZMmq29C!!%A`9!arp6&R5Fh-bd4"q&S*p[!EGSY!T[(j`4q'
+*p5@fiC,cR!pL284UX2SN2YFUa3[M%jfK9"VDr+P0%8cH)KG$VGFSrV-N-PFK82(
+i2NRhc5p0)DZ'"QeDE*L4XJrT!6Z0e@Nr@N@L+!Xkr@@JQE(pLHL@mEmcd`TBF5N
+N`Z8X08p5@[D"mme!5FJEbCL45Kd0EV)pUXEPaG!8GcLYKG%*I#PNZ-ET9+&F3Fh
+NlLkY-(KdBqp&[eLLXH+DC#VQF,p9KjFSbH@Q0[3if)@A$GI'--qKMr)X'9&J&Zj
+*mJ2JXl(k*F+eF6p2F*3h2erXCeHfRiZ[#X@h[3i*%-JjJZHUY4I"85eiP6&eUCP
+3`&8%1R3Grq#p69f@Lp$!4Aq4[I9b4TrkhH'R+3q!2AqTCfQKZGY%fm`[49L+3Qk
+IM@T8eX5h[9`a*JG*Y(M@jc!F55qicCpq[#d)0V-U)LIL!T33XbUT@N,*r-(c,0r
+p)YbbGb$3NdM,'RUPdTkl9%NHhK$q665r65jhXAL'-L,eF`Y)E!(HBM%m$c44MD5
+U(#BCCZFPE&ehhm$I43'(aPq`iCd6heAGBQZ5MQ%&Tj)pLIkJ(f!S0d@dNqS0%jY
+Kfi-9TECm(QFfr20JB-jlhe`[J`JZ$$mVrq)pEQG&KFbUiHPQ`kJG@-K2*5#d6i,
+e0*cdX0NVf1PB6Y)ERh4ZmU&lQ6mPe*e@T#$@m2TMh#1Tl0AQ'0A&dY%T%iY4Ida
+k"pqS$!2j#3(US8-HI!G6Pq*(!E5`9A$XH-@JimPbAC6hVFqfX4e(3(6ZRApUmU!
+C!TS8QY+ZiE2hQ3D[$)*5a4b4CEI5hHR[G4YcNG*XrQdh1hK9'DNLq@,Mh2%dpPQ
+'Al#k1IHI5iA0qV2k("l"8j!!r`$!hR5KH4[KNccQ2bAbDZ4kPS&LeSU-cDNHNHh
+N69YMq3PR!2LiHNl6RrESRij-SC3"IV`L"rNBf&Qrr6D&IAGkRikqjFjT`91PTSJ
+rG3Ac2KJUm"URhNT-1A6'EfKB+%Ti`S`jakF@KQ@3!""9S50eViXikb0`r1[%2Pq
+NQPcVJdCTR(Lj`9[aF)cS64RVF5PN(65ff#!cA6V,D+&0CElAK8+Ee!A+9@cE8R1
+*JmH"aK4EYkHe3FjL1d4%4Y0X2D(9DSD"Ze6lLRQLb1"I9PkU@h0!%0YS8QrpQlM
+CFLSFe+Y50$'TQ@pIjilZ54Y*hB8SdPlfi#DL45jmT94`R1+iaVqCTk9ddZ!l%'c
+&5er96FA@CY-lfi3&hA1$65TaY`qf+aGATm2iLr&-#,BXRCdp'b(BC*8e0ZG,9@J
+DqkeQ!D6S!P4@bamNAFCmiraP"cI3R&FhRB-mG&)*T$4EZZG!F49NYC`IT+j&0%$
+*Hac%i9YGLlGPaJ$SV#1Cj+N5Nr)$5F5pX614IH'4MMLfG%-4bdjCaP$Y!XcbB&A
+IMBB51'[9[BfIUVe6Cb$UcZ%mKr*qTX8@+A%[!0V(ArUj6``D!mS+p859AXYPJN6
+hDb-RZi9'il,9c`PJ-Vf9i@%"VTp3Ni@%J`a[cYNa!S"LHjXLeCiEJ11e-m1d86M
+MC43k$qRTKBEG40-Efm8#j`i"6ZXCH-+e(JZZ4dPh2'`dbHU1'KlaVN!Q%2L!`)[
+CRdX1Qq-5V$DqQ$("Y1dG)+4L[`#e%bXi,6r,R21d6p)EhH`$DTQTkQ)1FkG@X)-
+U)C1YSjT!Zp+F,,4)pEh)d#6K,VjRhfT!NPR[Ed'Z[$)C`1fed+q-kQ3IBcCGNBA
+Bm)!aKQCT%C44+P)J8H`BqPNIZmP!0ElLXB5D'rZQhh``6r82"3)mI)h4V4EDi2P
+5)f1K*Ia%4HafYlPpQLBD+QX)Q!r4CVmJ3Q+(%fZKeq9e8QY&,Qc5)H-fN!"Z"HS
+Er0M1(G2j,63blYK"-fm`dRGeD",+Pd8AcpEda*!!P)!*eL0eG'Pk!P*E3+GUhGZ
+*+*,,8HT$$$1$Z$`f+3aXD*+i`cTjEXd8`Q1(i*R4NUIeQM`XURl!4r-TVEZ(YQ@
+MP$HQMD[DP,6MdV`j!GMf[4d4Vq&#c1U8*9l[3*IrC5%2EC*[3cf$XM'l0CJhe8U
+i&1U+8hrj6$V8D[G)8TiTH+'*e-cqfB8&)+&pl#lYif3(++D5@DCANR"ZC8FJjXj
+0T#ASK'X5Hp%ib+*X!cFp%qE)S,-*%!&VFp2jJaBHVGcTU9S[dJ`%0$iV%(bk&IQ
+rUI&1A`2r#cR5ZaKTM2mpFBpV!q'P53SjrSr1aY2`00@lN!!YG2K3KXGHRCC$,j[
+)Mh(AZkCLJfMBSF-IRY92[bN-fVXXCjpC2QE9*cR"qY%*P',8B&&`XJLR!!qr3[Q
+A["V)#8i"89jX12AmJ(jT14A[PJ[$,Rq$"%e*&,CAJR03*Z5#`Sq)1Eh0J"19CD#
+kaQP0D+kRQm"Z186[&RGBYG1I`C@+,JG"kK5D*+ZfceKATK9G'hUX$D-iIDi)"*j
+`hTmCD*&$XV-2IU#p)36HrS,e-1hF-Kr,ITZ3!21lZ#YE%iGeKVGbfjE@ZMa'j8B
+M,L6N)TeMKTP$$hFjG$VVSj[Q'(k,$p-8fVFSLpl`TTkpBZc(+1M6)a0(B5S#-0+
+"E0KF'm3"+I$HbFRI)-[lR,0hfCrkSNmi)#EmCckq5e&8X[2(Cpca+c3LI85BFLk
+Y)h@)U("dN!#Ri9YKlSr1KUpQq11hjDr`IJ(1mH6Yl"hU,@N4T%#DHJ3F*k9ErES
+XL)iihr+I+Y)H30U0p((6%AP5E-H0'YaCIXrN#RQ2D,2*1XJ24N6K@'&@f(G'X8!
+5UV)Qj&h9YPeC0K0qQ!Cl3S)6,N4afFPi,N&*lF6c5J%TjAmi1Y"ri#XrK2f@ZjL
+4KNd*#K*+kT(V'JJ"("Sf+VJAe-h81&X,VGrf06'LrdBV+8MjCcU11chEjK,Dk5V
+Rj'S,,E@%+MbB)1kLC9X*!K%BNjfIBR!hbd&f,@p!KA6I4kBJ*12)XkdJD[+qXR(
+N&R68f)E)PU4*TcXD$qmEe6l3a0)Ji-6i0R3+aF$h2FX&I2T0Id(akU%`C98)%i4
+X$5a6N[D)&2Ef6aC+IUZ5l&G(L&S'SKHLX)#RiMUC9Aded4f4SXRrm4MSiqd6Fq$
+q23hbYa-#i2Z`'*e0$SlMh,PYIkRk5@E4fi!d(LZiBS`H'L"R*r-2E46bcqc""-V
+AX&0KlMSAUbHV0Z%0NI"0qSqkJplrQ!je9-iqMcR!49pc%'`L895PHV4,Yjj'98P
+0C0'S-cRq9m$JqHUjV8YjPMddilq!0#KHDZUddX$i2,Y1Ljd+ak"2'Gb0)rl(2A#
+0DjmkJj10*5l4)D6G*'Kq2NY$1eaK`B-H5!pIjc&GKX[((m*TSS9[NMN$Crhpkjr
+M1U)SX)E'-8LZp(p`mJqQ8VN`l'a#q2icZfGV)3IFh)$45#'&rSM4&RR%j9$PQLV
+*[T!!+JSdj9SEJXG3fm,[LFIeEBAP0`a,"C!!iV`J"jPTEa-EXd,fq@rQ)Y*RIH9
+$UR-mN4VdTJ8(Pe!1L&6lXPM9Aajhd#+#e@(3FhUCp@Q`A%3H8KEJd9&Z*kM1Rr@
+E[c4'aMAj"`8qLTa@Pm$`Q+*#Y2#&F[*j+D2ZpVG4"*NQpZ5)m[2$&(`U-*8@HZq
+dl$U#aGN[+03Xd9U`!a4D8"`X5"A94k(dkmL"QJSS)'d45MI4bZrH9rVAQ!lQ6Kl
+3NZ49cf3,lBGEfQAXlrIb@CQQ!Rfe(+l4mqLhJZRT!Ub4`"MNc"6"epb1)f-S5UU
+dq(rYkfAk2FR&2TfJk@EfrqS#rrpUNhAJja'2LKCi8QjKj'mIi,4[36"d*hcZAV@
+#B*+k,!D#S3pA"0R)eG*C'eTFl9f0p#!qRkpFYb#p$MaDH+(TXYM&Y$HmC``dU$'
+l,9p,8Vf#[Pdf@&ZX*'89dAq)lf1ek1pGIl-Q9-fR+1c@)pMi5Q0b@,B5)hd'Sj(
+XSkTATCFF9mX40R6RKeGpJ$9*Z`4-4iT))lY0K8Dh5(l@HfG4Pb(jiV&2h@2YPQ$
+GT`q4q4V`-A&QAMj$T5l5DJ33)4DMiB4rFBbG)*Ia%eDQNYm[8fAmrIdCY@Jd+9e
+lkGr33)mmhLK$X`hA5bCT,T`4*4,`4-3'$@6'"2j4FY`[Pk8BZR+C98fZp8rG)XP
+52aSF$ZUUQ@Mh[8ELiHCZ+Xk4&a6`4FIKr(#El`2q9@,e'CmP&2XqXikJUUrYZim
+FUJ3@k4CI#$'RV*d5U$9eCG25*[fMkLU9Lk&[q"f1R'+Q2%d09!Jcpj&YTQ+!p6S
+@G8HejXc)YUmYSfkALBH9*LNUMbdT9R(%96K+heA#CBNJJ`V@GRMV#TH2X6f*3l+
+eG6K@j"4&kRdcX@6HAG!bA0KR@XN"$"iCEZ@[1E9-5h5UY*pi1-M'1Tk@dpFj'Ak
+N0[ad'('X@&EIXBmVeEicGHkc3R@!CN4I"9V$[RVRZk*S)cZSLdp-Qb9@Al88Dp8
+p6JKeipYJ#Tm9Lk9E[p2KQ[h#,#f@[`$5,Y3H0AN9rJd!UF(cc9kX3*efi(rh$Tk
+IeBEm,Dak+#'BJC,[9)m)XGG+"E[&0FRP@LdQ$pb4blZaF!Ij-V",-hjCiC9(rC!
+!M%0)[4Sj6UI0i4@DDli!cjJehDGbD&'QL2IG3mG`AeiE0ZIZE'MA+ibGT5"La3U
+'[MD-cNMH+T2Up0DT*B[[2*IcJkpMXFKkVNT!+S!aXcQ#JGrQYSKS62C#6ChrDEa
+e0,lGP2q',E)-fHL'kT!!P(`iqp&lr9d!KTk*cp)YLXG9G0pf1C4EAB0h'4QEDl"
+1RQmX!A[9B6p3IB+64Pfhki9-'LL4fIJp[GUY1Sm0pKqpPh-,a4Nl3#3Fl"!QL4h
+TDTdS)rq4LmpH+k&#0$CC[kpXrCcK6*`A%2,+3q#5QRb@i3mJi!3e8QDm,E,C,i)
+rHX[Xm3T'UA1$+E*MKNU[MdEEik8F"q`eN!!jZ,$E[Uq)pcmkbc#qPJ5"'JHI%CY
+b1F-m0##p6DZ!-Q[%(@hJqE$iLc[-,!MS4EM,G#&jkZTh'E@DpR4%HdQR8'FdiCS
+H$PM)FG&'[DDHHrR3DH@pef!2J18!LXXG"B#kFYlL20Z#Q#@"+EV3#,GQqB'%[i[
+Gdm'Qjpddmh18cj)kk!ANT6)E'UF+9,c$hFp&mDb(BXcNhG'924rfN!!&DN0*D)!
+0+qU)"fceR+,KR,[`APD9aa1I!ZZRmeMCh8#k-RF-'r6ZArBC@jY@BM@`fE6kj,i
+I2k''[)EIp-"@i!3e@Pf!Ld`FlhXE5'ViUdGLGYADS'fm@c+PRqjlpC!!iXSID0[
+h@%l19d+[#i)T-4lB-G4F6cH`KfFPlMJqD(hQ&TV&XdZ9I9C@2+m0F@Hkr8qpq%r
+j*9l*Sc+AbmDNK`SG4J4falAi@'%#4Vq`'&J2XY$6!Tk0a20r4eahh*TqSpQ,"X4
+&m$l3AdH-EP9"#dcpNh@9p0+"-`GJ#YVrj*L-5"0BU&HC3hBr"KkL-ckAk9Y)l5E
+Z4jl#!qfhd1US+@YE-@E*c6c8,f'8jKE3NrCCq#9F'jbGp!lfHiKFcFdm&Ie3LhX
+KI(cIp2kXq)HbE5Rh[GR8-B!R[GdDZ)Z1a8d81HZTML#PfLkb(cR$r@bBfEPQZfE
+iXqCdGREifMHqBedRSGBRk6k`RcX@`'6)J0Ir$bZCbKZYjQ-@(MjeH6j`60N$Kc!
+Uj)5G8PGZp6(%6Sb9*"-"VRS#MrLEBKYG*'0*2ECd3l5[GL,#-4mLpCLh-SM8Uh,
+,'%+`h5-[Y1A%T3'@@q*6D!iC5Q@T#Y(b"JP[d3Ef+NCqa0#F`0&`YD(6PpfFa9d
+)E"V&bkfGb5hQE8mQL-ChTKqJ+58HaaP8m3"Qa`l9%%X8JZ',k[ZNHbVlFdkk&,8
+fBJbFcrJhdr6PYVa4r+`h*pJ-00%iP-Qb0I,*[`1k1)!S-1YZPRi8L%G)0X1MAmR
+%(hN$@5*G5iP1@$*1K8S3%h*C6%IHQhUpCCeCI2FfT(fCK3#BD'd+3)fhSiGMjJ(
+EpAm*U-`M)i2ZS'Z"#P'%j[04'lCmE%pd'GrBI(i`Gfmba*@`J5E4DK+P%E8M3Mk
+UqTG$qLS8h4h6*-SMM,6XYId%Sa0*2S0$*HSGCP$HKN,kjL%"q#$9+(m"4k,58Vi
+M1S*'!qEp-18LI+*eDLK)rhTriDUjZiAC+prINf"h#lfrSC!!MLbKFAqceBQA+'K
+ifq2hHY*qf)pDd+j0l8SA8NIQ3"!84bbHmq!@IB2Bbq@ACVd@80I![X"*clAdlSH
+G0&-jZ1VH32b`,X'Ke"JD1@-q8@N@T*@TUceH(9"4dP`Irl+6!8bcd0aAjHCA80@
+e-"D"4&Q"9ATDr&e-"!#PBJbmRpP2m[@hk##5RNLKmDVXV+'!J6%pRmlrV&2F5%F
+VM*Lb+VUk,6!2&()aV[RS0$*9&bd[XX&F#AREd-F%0QM!#JZ#dS+(**3'YI@2&G@
+m*E@0LiE0#51mXrr6PZ@-qT'h3BqdQBUqF%L6U`C2,"VCE0X-Z@0eeq%qP$*`1@N
+FYN#dK,d(-L`VKXmD9jZ$R$N+-NK$1NA6!F$pCmeeN!!Cm$cT&c*k0L8bbJHMQE*
+NpKV[dVrA8#0BX)3k+9Re@Y@Af$Vcp-"LAU%0!C5rBqFQUaaDcB49lPp+1M[BY[U
+j8cU"*2HhSd)BJ&V)B-CfHT4cYp@X&VRLEB1KX9$MPqiB-k$HF5G4D#6CXHKkI8r
+U4)`r-5%3'G`Sf0ZLI@0GkS,pYbhS$35NEdS1kC2$k0ahX!aaYQ6q#dYG@fNbFVD
+6Zbe)11N9P582*`#L6a4$65AZb*Rl8--ba(ID&6Z4Qjc&Y)%CK#hZq8m")63fIPB
+A'`NR*UHK8+hf5LDbBEMbIXJK+19X-)+%09@M2@UAdIF&62LYdi&TX,GhiqTYMdU
+2Va+D043EDGE5r)pZ4bEpbRL1(!*N*99[mcrkB*ZEaLJS(!hU8$r+ar48hhUS@$2
+S3"+M80dGi,[`51*+!Zk8930NL+pq*c4f8$*S"A9-&@qp5A2H+d1Nhb0[qR480Qk
+"Cm6lZ$N6S9eBB9D$@CeNlNq&QkUNNPSiQ5aa"0*R2I8'K34X&re,Hhl!T6GfCPT
+d'[mDTdq"*'K98r)[)p1(SSNRCm3$mEIXIadq6pp9$4J%KMIjUqpd2E*E@4YN29q
+F00-NNe%i@9cUX"X)B6l0p2DYp5G,Q0AF#Ia#0ENpGkh#i%Q4Y"DT(cbG`'fhlLL
+jHP'A'+h+ZL&MA"#8ei*4bp'qH*ah65VBM%dA4T`UmPcF13YX)d"8h8FSkekP6ea
+R6M@E"FdpUS!9I6[EAk*m1jf6-h1CcH&Pp,j,b1!drmkQJN`F+&$Lc1kRD2[KYSQ
+(D5X'-LcA1j8DDHUS3I'b!Vp'EfHRUHMa"#dIQ&8r,Y6ZkbJG3eHT@JRNV1lq*%3
+cY4MTR4CFLclY01`f#lD5#"3AThaSE5Afd!(6Kq@!`bd3DEpDi)f3!&lpBf(lar+
+1*)9!-S8T&Ye2KKb-)Nl+f@NaHC1R1)mXNNeq#r$%Nlf3!(Y'RFB)e2[XShALSF!
+fC*R+9%$3"0RVLL2AI&5flr81flcdpC6a@,8($-Ch5R2'C`V8XCb&aaUArR8m$j!
+!!e8P0I#Pc*``(T*#NkPE+d(-'2!Ef(TS'9FrBk3,UHU3!(Q%VS6jYU!ETp!Nl%T
+KA"`Y+3cA++'Z*dZk0!CYEYJTli@-9eL84e0!HCZF*S56p6H2E'Y5lkb63LAI-19
+Q[8`,G%SMK2!BJT!!Y-X@-r3M#C8F0MMFUIRLc'`[S2`Xr#ScUcKMeJmr%r,lGMP
+"[0S#ImFGKA$%9KiV6Y2Up(eh8d!BNkZNZCc$S$iZQhC6(l&H(B6UiB5hTc3J09Z
+TkFF@13+Z%D%fY1ERUU!(81"5%k)@5PQQ@81UP%`3`6-hjeVEKXdT3%,&iUKqkP,
+N(LVG)AJI9mYZ2&#[lCIrkd[@P1%kMUQS)'j0UH'SF4'CL[pkhF`[9dH%NkA(-lR
+LdeTmZIRb8A`MeQq)m%Jm0QNLfK2R)"br3HAZ#HbhL#BMIIQ"Sql&,Am0pepA5YC
+VVb,fKPL68LiHL!i!YY1d)Ta@aJ*MVHa0I-$AHL@H"6[jLX`m)UX*#fZXFI5&Seh
+S6D-42Na9m%Ge1b8jG!I*!m$[8T1P5`p(rZNJHq9aS,1Pbd-q$qD%H`BJT5iDejK
+)iAUZA%jl2'V")f2FYK`mP&-8(p`h*9C&Mm1`mi6k*4XkR$4k&0I3pJ!DeAlYf,-
+fc-RD+4PQZcDC9p%lB%,E"@A-URjkC*4pK0F%2IULJFi51IVF6$S+NjhbR`RJQi(
+ZkC!!'HZ!r"0"@TQiAKqQ4q[EL01b12m$CFDY*E(H(NmUGH1h+ceH'TM0,-2N"G4
+VHN+ec6aMLKUjdA)q6ZJ1T$Y@QSJ-ID(A1eH2"aq)"JaqRkLXee2'HY+''c*jBX3
+QI$J(R+Yd'Ue)D-QP&Ui59rP"BYKc5XCC"d`dY@LV(kI#P6f,L#HF8R!m,0Tm3B4
+XT%QAU232fUY@KC,mGAl,80DidS-9$qhlpABY82`%H8QieA+1U$%!XaTCDf1,1K(
+cLfVp,G&M+Y3S#BVE3UpYA52$9Rc2AIMZ%!&R@ATch"eDc`hqGUe`TTNSQXFMAhY
+8RFl5SZaM)S$6GXjDde0UlUeIVf[91Gc)#aSCLZJ*M,2mF[&Cfb1G(cDpM,4hG2A
+ThceRjD`XEH%PDA%MpbhTqGT660K3*0ESEQ'cJCL#h9YjArMJN!##eMI0HZ86HaD
+(H('QIj5BZF$&kJ(F-(a$KZdSkd`PKKGTm5`%h[Rc$!!chl$I+k1,b,*NYV0MEaV
+0I(EJPVGelbD[AbFHJTVjYpDVINZ-r5K$`ZDRR32NRZ&UmKZR9J-8ZjJ1CDfP5jR
+"UF@CAHiJU(`ZN@k!YUIQGafZNE9YKc3h58$)cUfm80@i29XLkmrGfJeUZSbL%5,
+r*EI'j@5Tp&m2e"a"PLBlp9G0aPHJjS-XCPV(h8*p)e'XJ0Sj'+'I@-bq-a0aHUQ
+jq38j'B*klLNLT)0&`6*rdQ$Dc!mCYRka'i%-aF$@0p2Uhk53!2k$(U3&8Ab8,d+
+-8q*%`!ad$*KlAN)Ah!m%G!`X#L,9,F[G)X)llji4Hq10'Y#m-dHaf8U@jeKHLS0
+Dp[,a4IDX1k5HLIL+Z$,G9SV!2RF4fmGDH6f9kaHC4ZdEe&YMm&k3!-iC,"AH#a0
+h#laG)jXAQJMZ9Lr0ZI9DiJPiJQX+JZG"5mF-'hd'C,E9)aD4V!#heTPUZQ$dLh)
+&#aj"2K2ILh`,l0IkN8'1p"5d(,2CD3&21TYSbfa))HD#`+@3"!%!!$!!3!#3#P0
+F!*!(FJ!!0S6rN!3!N!S*U!!!!3!!!C!!Y`!"MlF!!!4B!*$cI!!"!*!&D3"M!(d
+!R`3#6dX!N!Fp!'!!miKF9'KPFQ8JDA-JEQpd)'9ZEh9RD#"bEfpY)'pZ)0*H-0-
+JG'mJBfpZG'PZG@8J9@j6G(9QCQPZCbiJ)%&Z)'&NC'PdD@pZB@`JAM%JBRPdCA-
+JBA*P)'jPC@4PC#i!N!05!!%!N!9Y!'B!J3#L"!*25`#3"33!5!"R!31)-P0[FR*
+j,#"LGA3JB5"NDA0V)(*PE'&dC@3JCA*bEh)J+&i`+5"SBA-JEf0MGA*bC@3Z!*!
+$6!!#!*!&-3"R!%8!V33%8A9TG!#3"3S!8!!F!4#)'P9Z8h4eCQCTEQFJGf&c)(0
+eBf0PFh0QG@`K!*!&#!!1!#J!,U!#!!%!N!0p384$8J-!!(i08`U6K!'ME3$X#h)
+$Y,)b+b[M@dhH@qpUpkCZ*YH!-3"!!`#3!lUe$)!!#@NUrZ!"94)XqdV)@`lMjA1
+kK9'1XMr2MrqZ)$NhV"Vi%FU'0AQ'BU0RDr#XAMm&lZ`,`,#T"L)i6&Fq[H[,VD-
+C!m8F@8XE1!X!N!0D!!%!N!9G!(!!F3#X"!*25`#3"dS!93%6L$T6Eh*bH5iJ)%P
+ZFh4KE'aKG'P[EL"MB@iJEfjXH5"LC5"`CA*QEh*YC@3JEfiJ5%C6)(C[E(9YCA-
+Z!*!$EJ!"!*!&D!"k!(`!YJ3#6dX!N!G)!&i"*BK18fpYC5"TG'9YFb"hCA*P)(0
+VDA"`C@3JBQ9MBA9cC5"dD'9j)'&bC5"ZEh3JFh9`F'pbG'9N)'*j)(4SDA-JFf9
+XCLePH(4bB@0dEh)Z!*!$@J!"!*!&A3"`!(%!V!3#6dX!N!G+!&8"%iJk9'KP)'C
+TE'8JdPi`db"YBANJBQ8JC'&YB@GPC#iJ)&"XC@&cC5"eFf8JDA3JGfPdD#"MBA9
+dD@pZ,J#3!bJ!!3#3"F`!MJ$J!0)%#%0[ER4TER9P!*!&"!!%!--"BX!#!qJ!N!2
+8384$8J-!!4)08`UE*!!lLSL+&Fm@d(1X4'`3p5`rIcrXejfrjql1$+GBf'%P+PL
+&999LjEra",'U"3ZbC6Y1)2Q3!"m"9#5BqM@mKDIGaGRG6G,)HT+pI4mZ3pc&PmH
+P#aEjM6KA6jAe#b3m5Sk53ElSG,A`G'S9QL)q"HC1abaeLk9cJ@A[I"3FZ$A+c+C
+e3%m()3a-9j4CR+h"Zf9c)KIFIJai(r!m3+*2iaUXL26-$cGj+&$EM-KaUkHFa@0
+E8ER-cGETJDZ80pr*q`cTre6rb@d!N!3k!!%!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@0d)("KFh0
+hEh*N,J#3"!`!+!!S!,B"(!3"998!N!--!#!!#!#L!4`!JP99!*!$$!"L!*)!m!'
+B!)9993#3!``!+!!S!(8"2!#(998!N!--!%B!TJ#k!GB!KP99!*!$$!!J!!J!SJ%
+F!)"993#3!``!+!!S!+i"6J#e998!N!-1!#J!+!$#!D3!L&99+!S!N!--!#J!+!#
+8!4)#!&99!*!$$!!S!#J!M3%A!J&993#3!``,9@j6G(9QCL"KFcS!N!-)"b"QEfa
+NCA)!!!3c384$8J-!"RF093e$)K)4jPjZ%'3Y'84UmN3N#a"CUkBQ*lFpLicJGZI
+)5EFc8r+CIhHrlpZ+2"[Ic,He3*,9cZc*j%RB[MZ6%C,P9Z5*V-M[(j%rNjr*[0R
+@GK&*&K1b0bh*)LK!iJIr6PQ'N94%1+J,1hML*hBK,0+!l9$&S4Cf%PiIcijT$+G
+2[eNUFK-MbHfpC'm6p0EIcBDF5mJT4aqj[p)@X[AQGIR'*!P,+@RBhU3A&C159eN
+[%2cJbH(#&ajm5X-QD0&L4-VGcEkQ`r)XP,P*,SMR)FNFrFAJLaU$lM`9cA8P820
+dQ"q1j-RJ+KhQ[L68+ciKBT!!RHr$(BZ5%%MI@aB0YUmG+cH9Fc#*FlDI2+6+KXf
+GMlqi[`EXLf[bq5DTS"GBJ&RSpE(k4UNSE)5VZ#(4a%4T(NC4T5D'+#Hca)G5#DG
+%eC'a54-U)Z$aJ`C3q')!Y4*YQG#!*634DR+,6CR$@+QN(kF-V(@SLpVJf!+P0U0
+c9&M$',E[r55!`Li$a$PLQ,KZKIc2X5Gal+,YACH#6FZ"UHV$eS-Ujc5-Gh6@aB"
+d'i-,eVDeLc'L6-mKjM,F%r*FlYZBmf)r3FhBZqB8*mKFDkBmH&M*CEjpUU5NcqM
+UMHZl,G$)FrP&YX*lJ%6&V")5fb&&5#AJ#$hRCZLJ)NBKdc[fS@lc&8+41k84G`V
+H8bAIPL!j2GVYU6-RjVbF3lRZ&DPJc0[DAFTb'rRhYdi*$'iYhrbA$q+6*eD"#2h
+XL3&E#6aS*Xkh8XD5XZL!8d`D3&(YeTiH)j,QXMTfCIrBQ',QaYKL5NVMZKb[jqB
+q*1K-Xm!cl6p*FZL0,qj368Vlrpap[%LPH%SI@AC!''TAaj91(AL#-@"3aPPimHV
+hYlZRfC3AeqX$cDJ8$@fJmqd&j*@%XYf`G)B2KUU3!"Si!i4'pV`UFE3TZ%Vi1,Y
+29L@qKkdk$`8SRBhC9E-k+AX1V!#*JeYF)Z3(X`,GA!A9[Q0'IDaq[E"flB1d$rZ
+$9epp#4ZUUbq"F")bcdZiN!#&AS+9c([M)*1*kmMQF"*$DeK5eBS,0G(8$DlUGG,
+@)I*P,r@PJf6iV!k3!+U,`iQMEf'*D&FHY3@1%H!C2CVf%Lk!`1`-EZQV3EfDc)k
+)alY-h[lIZ!qhTr,*MDZ6TKGp,[+bNp-`jPQCpEJ64GUkaD!DXF'80&)2BbYeEc[
+GB!TTEhMfk&f2mYQTP@l1bb2j`E4mDbafS5aG4rV(QBS,DAF-pIPCbZIRk[pq5'N
++mhpAIXl%CM(qp[IPf*a9Cbj2D@i@qUC8h'a@H[,JJMDNfrH5e-ha@AMdST,jr-q
+AljL($06eY9h'+bI[Gal`F%%Abe@eJpQRlELVUi0e"4+H`Fl,5pZHa$lSC'#l'ZA
+eThN#F3DQm&#m#9iTh-1AH$!(GljqYG"C`e[Aj!i!N!-B!$3!!!%F!@J!!3%!!3#
+3"32S!*!$P!#3!c`!"33JEfBJ"b"TG'9YFbi%8h4[F"Y*G'9YFb"bC@eKD@jTEQF
+JG'mJ9@j6G(9QCMS,9@j6G(9QCQPZCcS!!!M#384$8J-!$i!1A3ZX%L4fE@IIRAp
+iYl&XGjihCQ,BfCc(6*CSle-E)bJkEdHa*eS0Gj-8#D@M,#1YSQS,UdUIEm-)Ejf
+3!1fj`5LMfG,4"USUd1Tp3kd8$qJBl3)PV8LV,Sh*PY#8pj8'"1apH0r[E[EC)UQ
+D9YAl!`hq3#-MB')c)N3K4$AZeI5R'm52eIGBY8"p'M[$-kQr)+C(ccpI0[E"-pr
+q[iV0kE%!MU6AKbr)UJUXM+(q$U`rekH!HKdfrSQJIrU)8d$#`'Y!DT(!G!B+G8"
+FT83$c'p)GKN'L4@)'S5T$Z%8T(QD[X(fVScHNGNI"REeMlhpm0dZdZ81MJm%9Ul
+qFVK'T"cBlIPImF44hQ,UG2$jjAPjMV)'Kfh)QmZLH1FGMdciUm4L@VEa[blr@m"
+@IIaEYSNXUSrPE5klh-`lS*62`A-U&h&S+DY0c5MPF2EBScYFlQf@XH8J[k!ZY!4
+MiB"rV9IC9#2UDa'P%r$,RpJ23Mp9mdDqFU0q"Zf&DJ1'88+i8@lkD+m1mclDU@3
+fSQV)d5`VX2CANYQEU*q&L3k9fhTX,(6rbV8ed[)hlTdq1,)e95,QA8ZF0j8lcYX
+Ymifmf6i8ZHYGc)Rjj52G6k9b4qphIA4"K6b5!ZpL9R9IZ32qr*cJXFq`kEcbjk8
+dhlGFcUmrRJZ[Er#XD1`bXeJ[E$dHd8mD4rm&'VBqNHbGkIj&[e$0U'm%Tkj,VPh
+L1L'Z8h5pMkl9%ZTkdS6k1RLYpM0L*fZ#f"&0%MX00E'6pK1a%liVLafcADAG#l5
+,kTrikG%-8a09q%FH)rEbi$X&JYL61T20P*AHmmcjpU`rYYd1+@QMmY,(EB,BKJi
+L)lC#KH,2p&CMDYBK5XZcMSGCKi$$CVQ%+!FhI2@@)$CrCX5'9haSZ*B9[G`XVXQ
+k,d)N2YX6$[S*4M@i+Ei)l42+dhd4Vj)QSZ[c-Pb*E0GEUq'@Q89N9),dkf"d8"(
+L9H"%*34E1qU56*@(b@R!8NDeJ[[JaD4P4bLD%+jIhcc5ZqAUY9AppmE("L*0+l4
+cUcBIQh3q!-Pa#mF,E5A@0)f#eBGhVIb0[)$&imfPSTl8fU'!blc)r"1N*dqBQ4(
+bV'*TRqpH!HRQ!bD&a[GbQQ4DCKG$Cd##!X,!,L%JPNjBI6GY$Tk2'$5CcfP$*Tp
+j-H3#+5*#Xef)L+AG`liLB8ZhZf9qaH4%EMTDQ+[QjLmhT0TF)%PKGR)0dd*T&[9
+RiG#9SLI"X%qLUS+S[)(M*e#[3Bfil1!VRXUb*+M`i5*H8!3+I#IA!RHIFK8N*X0
+X1h!`"TjYi"5G5N0JL8SX9ApmrD@ATVIYqhV`9IIECkmI'cMbKfYk2P@XeCH2ZH8
+Hq"f%R+DSS)liI*l&d#Aq!@pr1688@Jc0@TKm+Pj$i&cCTjbJUZS3X2mbf$1TLHR
+&8-)51N1&E'*eIN$fC9@Pk!a630&)bYDJS(e8dfcJl+UU9@clm$effPRJ#RcU(Nk
+p1MNEXRP#,UT[Dl[iPTNLLE+GP%AeP#(b!VLCU6eXh!RMHZeKcYe(a9a9r8mD(Uc
+$i"M8#-R5`TU`l*jX3h8+SS`IkE44A4V#Z"Al3U4pbb8ZPLLf3F!NJLSP)5-U,C9
+mCIhP3aThLC-"fLdAZGHeN@Zp'mIf&BUKUpcbXMGe9&[BHHl6QcpCkC90$aa#Gjl
+(ScGEXLQI0dADQ4!(3QRce[mG+&IJ-jl"jRQ4+UD8,$(PR%bNN!#Ac$e`f&`4NdF
+b5MNSpH&NbI,Uh**rS5NXGqaCfNVq@r+Xd00b`E1bqB,LXcX)JD*#8VbQeS+5`T0
+'MJkDN!#P`4JNBZ$9+(K62[N$dKR402fS4[hdUqP#d"%5a@KdUKX'0eQ06F(l[Cd
+1`Rd31Tp+CPkJqkBCa(%MSbUC$`PNSUh@rGUiIl$ha2VRV[K"8G@6b@5Xe6UZA4m
+FHrGKiIXrQdSQJc6Ce(Ta[(i`[,[Yi5qIdcFJ9LSTkU,ULkhDq+$l2cfP`BI1G+U
+$TMSUHqZG69qlh$%`j8pREY"U8lh@IUhAfGXc%2cMp`FKpceP%j+5frMDDlh1[@d
+p1`F'R,#*$L8T841!5Ua(pF$q+L%"#d4rKe'BY$YQ0I6jpaK9,if1@SfBmMl+Tfr
+p20R&qNCrT5HljPY[dFj",e6CPVL1'U2k'9")+mEQF'cTbMHGCc&fG+lD59rl$X"
+QKEK13)0!Xa-#+)S,iq@[(cU$4ap6S!5&l%+UBpIYAA[k,)2f,ed1IRA1Z66cHYN
+**!VM#!,6p@M8`Ir)BZkdQ2T5r)2ESm,5c'r+k(q,EUVhTc&lI24!T0Mb8pIFTVl
+c#FIT8Ir53V'C13a,#&baCFNeTfYP0X$`L2p0X-F5$VlBBREP60Ur3A9'K@,KPS,
+9qk1ENKZE5R5dPZhDdjdEeJi0"2QjpZI[$l#kL0Q9EeqQ$S@24GZ3!"ac`jJ'Bp+
+'`ppL1S2EAa%pDB4RZ%#3!(rl)YF#IG&4U&8ZAqXKGM*ae'!X5Q!QpD34(ka+q'3
+RYfQPEUQqd4h1j!6+[I)%l+9c*2c)Mr%*58e-DHB%"q$MrAGC2Mpr+6+i)rp4Hf'
+dmDUHaS1ch'i*i`P*&L409I$KH$[&bcRcl2$Z)3mafaQ+8`qb#DjX%djZNmJ"D@G
+-`EPiR,Af0DTE*Zemr$Y0K-h%N4BR#8Q,Cq-bC`EF)@IM3F$T9J30F&-9hTk`0P0
+mGVMX[Mel+jf*F0`2@a%dF%HTiJk1ZdYa@ri(1r,MfjS@'K@mMhkQdY2JDJJN1UL
+EA20Q`ddeQ6BT95+hA'RF83$@d!"49h@Q6H)`)VX9Ql0-!KL%E6dQT#fLA$G-0%j
+,'3B*efpZ5$bq9@-c$@,3**FRfS14N51q-RNiAQ6*Y%F9(@C%Fqb9mDpELXTN,Zi
+cCjSMSh65'J`Y$E3RdaT9G#V6'*a)CaZML[k#P'',-#P+*EL$AAXbE@%hr&YRI%Z
++)EV5BfUpXl,+$*p(j&$ZP5X!N!3D"9#!!*!$!c8Z03p6G(9QCNPd)&0&35!e,M8
+!N!-1"9#!!*!$!c8Z03-e,M8!N!-9!&3!C!#,!BB!!3%!N!F%5`#3""J!2!"!!,!
+"Q!!"!3#3"`%(!*!'!5*"4%05!`!$LJe6#TXN!(q'4E$G16N6X-81A8Y16ahE!48
+$fl(kf!a@pFiq++KBI@c"EUcUaX!rBhp8p,rrEircGPBCaZS!#jNe$9a@MI6"MNE
+hVP-Dl!5cmbJ8h-AL-N+fe,NJbA-,N!$IEi*fJZR44(62+AQc%pfmbHiVKB3cc%Y
+DkTT5LKd,2KqEdhm%m(Vq1HV+dqTUrjpIEXHVRre$rrZ4PL8#Z$0USi*Y9X&)*Va
+&Ufb-9E9H@cjLQlH&l@%9IG`AaY*D6+58Y!*a(daqM-2AVK[QKkBCkP2EpNhG$lS
+3D&U!*`6)!*`!6,hk,3$qkJN$%Am!m+*bi3)3()+!!B*LB#diLj&"M0m-3Z351Z,
+UBj,-[5Ka(dcIG2P&a#YXbaJ!N!0h384$8J-!!)!08`YE)!-$TQ$$UQUc-,!")Q*
+J0dZafeQ9S#"L`alUfF#B96%,BbUkpkG6V!S,L@2)YZ*heJ"5+2hK[F##5VM&3+G
+M5$+1VpRh*L)1[qR'r[[BRcTA6bLQN38GNEU#'ELMa4UZU'SRT%mb#Zp&cJ8!N!0
+-!!)!N!8)!$3!'J%EL"Y3E'9KFf8JD@jcCA*d)'4TFfXJAM!JGfPdD$S!N!B,!!X
+!+`!VS!)%5`#3"4d!0!!Y!4L)!Pia!*!$1J!"!*!&0J#(!%S!`33#6dX!N!8#!%8
+!,`%rL"PH-#"KF("PBA*c)(4[)'*P)'4KE@&RC@3Z5`#3!kT"4%05!`!!YJeE#e-
+`!hGc,@B'l"R6bPA'0c6M[V999XBrEdr[eAUhlMhriKXD!!$`$3!!k$B0!!!,XLd
+EJDAi"hCRqrRPV5ecdeE0heRBNa&Y1kd$*bTR@GR*V[*iehG%KH"5a(q#'"5q4!b
+Gmd**U)B"*8+!,UJ1hY8&`*1&(+!BY25$@4r[#**R3EiJhiV0BEcLr@Z6"D@&%LZ
++ZA,FjlR#dP4ijI&K!3#3!``!+!!S!(m"F!5[998!!!%!N!1!!"rr3!!J!L!!)J5
+3!!!Q#FJ!)K2N!#)J!J!L3!%!))IJJ#%2m%!L($!J*"Rr%#JDLJJb-SSN*M,b-Ni
+d"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!crrrriIrrrm$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!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ
+2rrri$rrrq!rrrrJ2rrri!!!"!!IrrJ!)!)-!#i%#J!K#!N!*K!)J#%J#%!Z3!!2
+i##!!#!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!rrrrJ2rrr
+i$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrr
+i$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!$rrr`!rrrq!2rrr
+`$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrr
+i$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrri$rrrq!rrrrJ2rrr
+i$rrrq!rrrrJ!!!%!N!1!!!!"3!!!!L!!!!53!!!!#FJ!!"2N!!!J!J!!3!%!!)I
+JJ!%2m%!#($!J""Rr%!JDLJJ5-SSN*M,b-Nid"MNQCI3b%Q88*!KRr!J%F-!3!Mr
+J)!%"J%!!KX#!!%!"!!!J!J!!%q3!!!R)!!!%N!!!!!)J!!!"3!#3!i!!N!H!!!!
+"`!!!!q!!!!I`!!!2q!!!(r`!!$rq!!"rr`!!rrq!!Irr`!2rrq!(rrr`$rrrq"r
+rrr`rrrrqIrq3!crrrriIrrrm$rrrq!Irrr!$rrrJ!Irr`!$rri!!Irm!!$rq!!!
+Ir!!!$rJ!!!I`!!!$i!!!!F!!N!1!!*!)"d&38%`!N!B(8f9R-J!"!*!%"e0PCc-
+!!Rm!N!-(8f9R6J!$r`#3!`G"8&"-!*!'('&eFh3!N!-"5801)`#3"B4'8N9'!*!
+&K!#3!c4"9A-b!*!$!8P$6L-!!`#3!i!!!3#"!!)!JJ!$!)0'8N9'!!-!N!1!!!%
+!J3!#!))!!`#$!*!$)"qT)$%j16!Y16JJ3@aKC'4TEL"6HA0dC@ec,#"*EQ-Z!*!
+(9d&%3e)$!!%"$9-#h0B'NrI54Xe&%fd!Y2Nh,VcE64YQ`QbqU`[IK0f`fq6GGYA
+9G@%!#6LPL2pd"ISD0+Bf([[%R@[C6S+*X0-3qX#ck!"SN!$&[[i%[JB!!!3!N"'
+"!*!HJ3$r!*!FJ3"8+rm!N"U"!&6r9#[r!*!BJ3"8rj!$9#[r!*!@J3"8rj!&9#[
+r!*!8J3$epT!$92D3"#[r!*!5J3$epT!%q2D3"5[r!*!3J3$ep[D"N!C@prEf+rm
+!N!k"!2Afp[hrN!Em9[D3!b[r!*!-J3$ep[C@rhrhN!5"rrIfN!3Vr`#3#S%!pID
+3!rcppeCrN!@VN!0rp[BVr`#3#)%!92D3"2prpRmUI`#3!e48IeBVpP3Vr`#3"S%
+!92rfN!0@rrMhIbTr!*!$9&5Vpb[fre3Vr`#3")%!92rrpT!$r2hh9P3U9*!&Ik[
+hp[Erre3Vr`!!J3"8rj!$92MfrhrfIbU3"948Ihrhq&6rN!08q2m!!2mV92rrp[C
+@rrIhIbU"N!5X9+Y@pT!$rrp8q2m!N!6r+e6rp[EmrIC@UbU"pT!$JArrprD3!rp
+8q2m!N!Er+e6fp[hppeDVUrq3"RrhpT!$92Mr!*!)rb[fpPEqIrH3"2q"pj!%pT!
+$prMr!*!+rb[fpPEprj!'JID3"IIir`#3$2mVpT!'ri(hN!2fN!2hq2m!N!lr+rD
+3!rrrq2rrq2D3!rIir`#3%2mVpT!$prIipj!$p[Iir`#3%[mVpT!%92D3!rIir`#
+3&2mV92q3"96ir`#3&[mV92q3!e6ir`#3'2mV92p8q2m!N"Vr+e6ir`#3(2rir`#
+3([m!N$&"[N&%3e)$!)L8%&80C984!#&9lNDI2Tq98TFkPk@C#reCjkb$V48jAMZ
+Fd(A2QkiZ@qd'6S+ZX+d&h22ZD`aF1&jF`B%,)!lN$%F-QG2$E3JZa#ra1-qER'H
+)ja%daP2Meb"IRcFaZK"$b"cEq[llr$jYIad$)CIAprmj(9Bf%K%#!C!%%3'3!a&
+#$J"G!pqDp[N(HU)c#(`r4)(q$+l4p(LfUCZr"#Ra1aIILiA8p6rlPlb5LBH&EZM
+VDB*2r$L[K)i5FC!!(hf6L0TLZ[8@@@-q,f!FSN(c`9#*kT%er8fR%pm"XG16b'X
+kM38%ir19DD!Tf`BLe9Z$9Vm0j0i["hrf&fIb8j!!,*ZbMB%ljp['QVHm0EM'h,3
+EberaC36,RAcC5DmR5N,RPjfPea-P`9Dqh!QLF-qbXjhr"K#mMMlZNb!J*K`$cq3
+j3bBR6)%Qcjri`24@jlq"MP32)R09mdj"p"ddhcr[EXm4ipLL%%qZr'EmHb+!Ra"
+qJUdj3[l6I`prDRl@&J5abZ+X#!f*rjRkkq53!'-SUcMf!*pf15[iBPr%CDlr8he
+X,Kr+cL5Bij'KN8pM%S2D#B+Gq-B"eG3r-`(,E-%S-U"1CXaefCi5[XlY)%M'4&+
+-Lfh#P(pPUP#PiMprRISV0FcBe&rCa$N-Qr'cCI3+68@Zm1P4rA6NLX6+AScY'a2
+ID2jaT#rD*i*j3Z@4Emr[jL5$JeEhjpf*("&GqCracl(jcl(jcd@`iiIT)YE@mJ0
+eJ'mpHNG!(6"Ec2AA@f+kP8H)PEpb1D1f(cjKhZVLVbVdaeYrq-59V8IP("3Z9M&
+e9i016"jb(-TYN!$lmlXliN3dEHfhhQ*08PD)bQ)GD$V0"ZPB5%[+6QNP3UR%h2G
+GpL*#l0TKRc@T(A6TMra(LG$C3j3G++Sk$U#aNGHdfi%YfVeB4T!!bCKXqmXEBV3
+E*'$mKfbj%[RMcS0$M`SaP9jI+062erQhG"k%bJ)3qm*SYrRqM4Y2[5dm-!L220!
+8FbCPeci3`6YV4Mr3&#I[e3FRQU3!C4m'@aBb2k"b!f[X*NIAZYP1VqbUcT!!hkc
+q5-k@0E+rqK6)rRiE-Fe3l8QBlpSXX*QLMA*fiMYrh#bm)$Z(%[jBp*kpR8$`Mmd
+LT2RTbh08ccJ3P#L6j-ljZ#a$L9,EAmV+(&f"!@HS@F@h3F9a+E*bNYL!2hU1"0N
+24%(!&lkmP)Ycf1@KeEEKcImJ&U'#3B[@IJ4j6@A%QVF)mC)@-@bY!`96IaL#jj8
+)YQEhr!B9`F'1Y,9H#Vk)P%iHN!#h8%4*JCXL#N%DN4qE@K0T-ZiE8kQXb)#3!*%
+"d9PcSVXeVmNS*qe28R5EllH*p&$RpS5)*GX#JXMEdFk$VF*XH[qcpS"jk,hkkiI
+-*T1TrV1j4k@AB8FQY%F#*T2CC"qIKDDHfHAd@6lE"#'f)#hNN!$%Y)Qr0*[D!bR
+IZ2lSACD'Cc1p0Fp'3Lrr'&YR6*f2UP3P(L,$@B18V4L`)DV(9%8@-E(&,kS(UP2
+0HFf(Qh+ELUb)(*@+-LLD@jTYcAFMNq1rQM69XkTRb@2'P*a8C-J8hVNi86G,f-H
+TJTkd1(hi#FAmC*c0Ff*4&,RUQ%mDDV--jPZ$Dr+D2Qbm&jpTM5Fl&hql'#5mU1N
+Y-0BKNh$2L@jMB!,JGRA08`#f'dpmQU[kHZ1N2'Br)m[k5adZZpmBUJFC6jq*pkQ
+V-3+Qh)b896+p,)qG5Fq`Kc%&+M(pAHILiSe2l9dV'XIiCqP6He@UaX1Q[-DqTrD
++D+1TFr'Zc8$m1A0D5'!a"`I-b"V+@e+(RkV1'6qiaKBh,@kHHrLjd*3YhZGkbY9
+m[5Q[q5BLLH"R,P6m4HF-mc8$HbIkS16jTN@U4r"6MBTjXqT&X&66clia@dAcV`e
+$[lVjef"V(-KV,P8Y`Q3Mr@MCf*!!f0J3*!Qr3330[Aci!Rkqd,*qJCrhY+ccfG$
+Ir1Y6pAeL@0J'QTqN$"@,KF!9CfKri&5hFQ1)UZ[AQ*XI0dkYF69[aEBrG!6Y,4-
+20hpKY0A'S1"Kab,9idieQ3%blUI-D5,daPq#b%TGP`,&'E+5GPNT'`P!&e!SS5a
+IFelMD22(9Tie+C,06e-@SNJLkRC92j@`d!Y8mdmEXP`-a2mZ1%R-Mba&N!#HKi,
+%!C+DFm6fUVPqQl#Y%9jcIFfaYVeq+PepFir&0Y'V([fVea*LidrTAqP2ll"X2@,
+$C+[BH)AqP9kjhV)9)1FGVpN#XqK!b&b[Ff(K`m(,fm6'Ur5[p1V0PUh(E1l+"am
+jH[2P6DLUjrEp2DV9[am8)CY[ELm'[R##2@@%!SKTkci,CILEUeZ42BFLf9(p8AZ
+N#dM1Reb++qIG*N*M!ddIQYrE-G!dcIcCmQ0MA[0lbipY#fM41,,e@%VbjL1("jV
+Z0RmIE(2"pYTKYrRlberV#@cmJ2k9I[$iNDf[c6S'92VNb!e!$*qc3+eXELqIm(&
+NqNIEj-JqR@KTVKl)jYRhKG81bJkMV,[K'J"f!if66TdZ3YR@)JRLe8"p5AbE51l
+E*T!!23d5-M*)+F)DEjHcBlVf&XBB*%Cj#$Pr5BJ2BfhqrqAXGM1fh5(IEP!3XL5
+6K0*%@f5dXRV)`-`S@+`Y4&5@(6$A*!TJl8&VN!#1S#UCd@UQ*D(3I'a@R#ka"G[
+Mj6*I96#rGKh-*aA-KeCR9Me$"Yjd4Q(Qcr$-j&a9FI2(p,'1U3T9K8h0+(L$)YM
+d6@P5U)@kU3',!-$3EqU&8FBSNBaEbGa",JBihY)ZRVBie8ErG)YG4V9C3CNhcZ'
+IhbG#GKlmpRQ*d+hDVqQ1j4Z$de&F'peJES1M8NM+-QdA+EFJ5m9(VqfEV1[fH4Q
+DKB4UmmF8pE)QUJ-er&BRQZK#EDZ5a"DkM)%6h6'HI4[e+09$@CGS+&HBrd%14ZN
+DpdQElDQ3!!43GSSSrZRSCdfNmI`D9+#0@A*5Bj&GDc50aM8!fa[6Bqha(M%#a3e
+M-@903Rd9FYlLB64QG')8cER&a6T%YpSaX144Hd)11MfI5e@41PD"3X5)Rr0JNMA
+G"-Sh1X-L%&&"88*-a)`UbfFS8Y6N4X5,&0S'A)+Q(VJd1C3hc-(!GGBSa-Bd9bD
+(k2UXqf#SIX2KFCNbVN(56q*`"3kid6aGr1Mj@B*-dcj,2G"mFiSD8D5f$M5A8Y-
+ei*mPS-6a8pe3UTZbE(j4CBXVKL1ciVBJ-U88fH0aR[N14kANRX$H`&1$c6HYk@X
+ZI@S)"I2$5dT3--rP4I&DAK3,-8pllHN1A!ZN+0YqZX0bSYZj9aU+8P4L*Ab`q&%
+MXS1m0!%hMf+1M'(LXLh1P9r[S#fTR8FMJh[33P$Y$@1E@HRBlU9aC+ENlh26d6d
+L-MMDM80Q@jQj(J"+X8+"I'ZN`$6"%+hJL*SBSS19%"eS6,",1YQPfUPA0pVLA8*
+#Pj!!YAR$R3c'a9+Q4UUf5@@e8mmYELkeYmc)DhlF(L8!J&6Dr%Ae,kaH3[l40)S
+XTiFZ`T9*@ecj`VjCHB'96-$r#N`)fG'0F$5#3BP0XX2i5Qe-BBVV*%DBQjVBj0Z
+V2hTP8XJSm"$!+STIb4DY[`!LBN!5m-THir'$@D),JK)NU(de8EbBR8*`m66&fl2
+PGFkZFJ4AFm'jiNGD`B3S%`[Q$MLRI+N86kEGUXqXkZ'"QbVe!"3qeMr8qEb9QDY
+U2eAe0(dK0@Z6GMU'k5#ElY*11c$YPDE2'%4X`V5E64Y%V-5dMddE4&!'CT8KF""
+iZrpQU6%2XQ8KPKqm03J5Bb'!IA,MN!"VBl2%[L%aa3'3!(3!lVX,(U$U9aPXCFG
+3D3'bRY8Y%8YYcei"m#Z+RaB3q)BR5JXHJ'MC1!8#55[!)%%!cbcKp0Q#-8!GFNr
+"CLT@eF)1C`&-GH&))Bl`ib#1f8bjUR&qF+hLB!Z!3&PP!8'R&9F4D,J!"fTjGAX
+C'fer*lZJa*&E8!)hdDh%`X3ZJ,KP)-E93q4PilZe-9ca#5DU826dU+UNi`8TjV3
+!'PclTZ0)(6QD5B8,I-m#652[C"F9dV,jQilFSN,+@!)a-`hZC'1QcVkfTP[!823
+1Z@mG!(Np8&58*`+ZcpPVC%XGJ+0D0J6[jDk%`kJXpU)CL8qVCL#LUSSfNRN)[pf
+MFfJZflB4Z29%A8VbMXYh@*!!9EicjT%GQMSLc+2aTRpCGiG&0i'Y&G[`)rZIU)2
+!RGbpX!3%NDrSqX&)lb#Q5`L%D%,4,LHGkHf4MPIKdUED$kHE,P`9'k&QC-0Y`QZ
+2FJFdeH&0Qr`aIrk9b0$d[TbY$M!lfdNF)EQ[M!QDfPF'p4M8&b+Pc&LNXMKEi+V
+RbSVLiVU%j[P$'5M)mKHT5L+%*P!%SE'i!C9AMP$GbaA4!6&lQlm%!f9J(fM),5V
++%8ANj&PRZ'"lbEkHSX,QHGa4%k+VRlIe&*5%J6p"&$LSr[DaDUYc4[5,@A'&'IX
+P4b@V")K%6Hr'1CNJZ8A0`1b5*iQSC&T8#+H"Y)$NPJJb6b"2L#X%H1rc0Rf$3(b
+J98*1LIaPM,XMPZ`,0P@dCPZ6B#`bjaEDm,1TZ5QkL-!a9BQp(@EaQUSScir&*99
+4MMUDkal%4!8@1*,Viik)AJ"'MXL3!1'+kDkFkNLIK-Tc,UMXJ!N916BkX+611V#
+NbTbf9NhES#SIC$`A0Rf6SHSClAEbi19Z-#eHFT@BEN!c6*MH3%0-p1(!+"M9p-,
+8*$)!A!iXZ@SG@$b-DEr$a5XZri'!-@10DmR9FPj(lF,G`DBmA)`Zm",!MP-FB)*
+cT&-QN!!9Ved1m5BD6*qkPMa+J-J*2@)HKaY%b-ZRZZNiM04Pc[Yh0"'6U"L0'4F
+Arh[9'N`XZ6,J+[3DQ!KFJpJC49(P9Zh#Zd!K+,H3!#V9jCdceVjHL5hY+EaBXJZ
+IKBeT8B66*3ZG&@LSDQ,#Hm+S@Z-##SXIVCNSAUXH!TL!!UjVVCU+1(2ZGLm(2be
+!F4S0`GM&+pSaiHA6cr%UGI'MDMEYjY1eE0UI*YUpK',d2!$@deb&#D"f(ZK59"L
+*%B26B,BF#"!$!R,6!F&I)+VT4A4!H*H8D,T6"i(D`*+50bd%c""jBULdm1q0hZS
+H"'*[i5DSXSk-%%%ck4#DERX,TUj+8iA&01AdIJi"&,!R4b2b[V&3J*S-a)*Q!Ul
+#"6f&Qe,Lbbh593e(00dj5@1m"Y1)5N*eNl5eBSfQ@b&)m+C(C1MKaJ-m@d$8pX"
+aRP65JN1NR$hi1BU$$4`m'VCc-[+54e(%hl3'VjFF-1FL-)+C%*NS,Ga%`"ULl+L
+H9&$Sadp8)K9dlBhQQIUDLb"UbMR-5593qpGdNP!!M5*N-DSDB%jCCN+c0mdi53l
+EVGNdl$bB0dM$GLV8e(*%TljQ8@&dXUSYeq8YK)XJUX6*IB3)c)FLVedRGXIf+U2
+0!9221BFUVAEZSU)AjY*a5eZZ%)A4Dj!!c9'`$022A8[,d`JB,V8!S1m#'@q+#8M
+,lbB$T3[JbYC6F)@#Md[BNjb)b9mSVmVpb[%XUT!!4FqKQ%TG+RYVX'MVSHZX3J,
+SbNVe8@0k#f5T5k35,`UkCiB0+JRN1RVY-9)aJ[8H&#G(#IcQ`6TT6i5pQ,'cNkD
+9J5KJidA38@,54bQ#fSR`S"C)NTTi!9"X"5"D[!@Ab,fPKD-RVU#C*F4lMPkRcc6
+`pLXaEKJ!94$GK16EVfLk-I!NS,ilS$j8G)(9&$LL4*1TD#j93V%9E8`A[V'[l3r
+IQ022c&"Ml5PSX2B8c5cRLMPNX&B[E3ULEA!!TiC9Lck+G)*(%PU,I-[%T-[(CSS
+h'`SRN!$aLQaa+Q43l,Li!)R!peVRM#dIJX!R$1k!h&Q@Jj6'3(Y(`&IrV0-Il4#
+Ui#'l`qM(81hT#19&[DLmPq,MYQr#kl*3PR1EdDCPVV+[0(U*HEJMm,eS%-`9q,M
+Yp,SXF0U1l*Dh%`b*)jdcrP"kSPY5"Bq-K168$2#40ehP1-`T*(GE4I8PRYNFlCc
+V5!YG[5eK'a-eA`iQc&J!X2cP(+HDXVN!r+qYVYN(mJN1ji$i$,01Q'1qi+[VN!$
+H"82e9YHNbj32!R6KMNp%#!Pk&Yfc9e8%pf9U5UpeQK`!AR,PH`Lm$r'VE2G3`L)
+-eLA1Y@)3%U(BZ1N#2a)#-kSY6(XalF-L+%*ikBefL9$!QTY8G`@X%GHV,P('K9A
+iZi4hAF,THj@%qU0Tqe5KUbHPi9Te9fJPXKLqY`-&I)2mjSq4U6Taci4)1VT#&fr
+cY(3&YQ-2hiL#q'"2!['EAcd[bX3Ypk5&e+,#N4EFPGH(UbY`I-cN"*Qj81kq)5f
+C,ca'Ifh-hRV$HIMG$GH@f8IH1#p1#pXEHhXMrEH,F@-!VhhhR!GpX3)+2L$h*q#
+8IIL6qkSklb+6S%*9bSDMCI9LRK&A!4I,+)Lf-*9%AD`Gf@UcE'2h[3aAbqMXq8k
+IBlkc*ECVU%6)Ijb,c%9LXh#h!6@j$'Jqk*`,pNLXG(pQbKP8hV'mikRRXFJimrX
+cql'S)j)f&X[YaS0`$K!,rTm-Q4DEEcZCJ89Jj(KkeQeBQ2,bL#'3!*&b2)m@G9P
+Bd8+`rf"-4a1)BU-hHN%F4"+`PZL&d(i![Yk)+qC6Gd9rHB)bdf-JfA3&6Q1jQbT
+JLM)-()K%Em$Ul'+4YNRZIJD&jGIHYIf`aaaea6h1iDKVRmHTaUI,@B'T,VK-L&J
+&VNdDB3l')*Nb4!NTSR2(T8C3+eIPNZ"EJe+&p8+GhBFM)ZEMlS1886j0-JBaR$#
+hH*bLk)lC`VlViSpP2el1jXEX+r1kr@[K-Xc0BcM-22aN(J#0bX"H*CPL(T&SZU)
+rLq*'Ca5IB*jhdL8K@"46)ND0-lNVi(qK$NQG2N!J(@lk3)k$EHR[PSf-B"K&TL&
+8SrDBAHSI1+a)5&H"MmrTIA%XTUiHLd@PiE)a("P,!X8i6%8Ih0'!R#Ch[i%QS'L
+jJCV&!2c%#(iq"4JjEKbTMN9GUQRf8,8J3p[4*$``Y"EQQT,8#m"42j,$`#N#NhJ
+j#L0mqE0B521CpJ+rN!"[S!Dh"i+LEl`X@NhRa6CFdZ-)f,h9S9LS1NLLkA@L#Fj
+&pbDN+a"-929F4*+Mk"I$eEm!D`@aR2L!-c4`KKE1S*Df81fh$q1+mHUS[@*S-ja
+V5K&-&SPSp5h[8+)a5A`&2ciYA$`r[VE5&G)QSpMNVI5+"cSSU&`@Mi+PCc@@#Z(
+KM0Zi8RUUqk5!Qk#!5p(T48DY(q6q8J4P*0k!@F4ld!a$BM1K9XHmkXdLJ1+ea+4
+Ql*VQaf!!hN3GLQ8rcp"$XF)!Z1I*&D5jQT4UZP@11a18L@Mc`(hGlabHl6S*4ic
+*#DG2lEQV2VC,VBkiUR[d43J3[YXDK&Z6@[8i'YThedl0%L!R41'm[j8R"N&'NSf
+LM$I)&1Cd0`j9U"jr"mbUV4Mi9B9F`#p@-j`UDa"X`kTjB'Y4[F!2ISA'l))IdH(
+IF+H0DKbZ-Si3fB#ZaI@2m'XpfQ[9'bDX0RPGSP"*LhI)U@iHN8&"@(L"Ui',ib*
+3BYPeh!P4%SNb`1iCS)ZDq)CIT%2me5e)I1$&*5-JNRRB05d+K+Fi`QTq496e&Gq
+X6lpCU2J&MZ+`&N8T'9[91h4S(Mrd!Vr5J0cDeG@m#[D*$@)hVFCqpc[%XT8Lf"L
+UM@Q$IlIHJ2JQYh*P2F!MJ4Z6XBaY8QdM4h9+1%5*&+40Ebjhd`mKS5TP!b4"L+X
+!#E0&Rr!Zk[+*[&P8a0ij+#AhDKU4%Pk9I#%Ppq+N5cI)Cq[LP#daBSZ6f5)"d*b
+p+Z8V5UU)"YB,Xq,f+"%ID,Jp-5X1Cb4rG%Me%a#9Vjb5NX@9NQXNQPihJcQG-jI
+U-cLNV#*9#+p1%cYG!0E0Q!!LmVVU8eBNKD-,QpmI!r'fqHeCmHJLe+BK9E&pLKq
+"1*BSBACA2&DKRm5@GR8"(AYS&JL)0r`P'E2jD#X!-02#JZ"$42MJ#6LN4#IU-'9
+eK#RV8dPCMbjRbST+#QRk&#"p[9ipTRFPj4619bURa!I8Ke4rXVGS'GqLTRcK*k3
+dqi&`C@e[`'&lHFSUZ"D[fJc+fJi"GQ3k02pXeHVC[M"F2BpH%kiH#I!fQ#X[&MN
+TUH4e1!,`$)aMaKfTCp*6K*6mN!!+E6*(bG%X-[(#V6a*hBJY-$N"ac(e,rem)LP
+0f,FB!`T5X5%4h145GD4hPMXk*!*CG'"X[h$djQa+%kf6IhTrp!Sb$BQ-@m1El6a
+V5@i82LbQX%#LCL358epM!EQZ0fmDJHVMLZC$e%2C0&5J(a!M8ehZ69j(AdiNZNR
+db-)qU(EAK#+LaC)@D'qlGQEN8Uc9eYIUIh@*5P8R4Qj!hT0E(-q-iR2JT-pl!j,
+MLFLP5"mUPPYhH-fIcEENc-Ae[NP6lL+kf'26ArajYcR[GC!!3#El4c14a9#2UX4
+R@[ak5@`69$V`HJPFZa$a8rI+FAZ,0#84ihia&k#0@TV#`4)j6XGiXhh(k1qjijU
+@f1l!+f4R-HBIHZ5ipZ"-18i4"mFeLE"A5dN1@AD9'XfTUIh5m9ETL*9R1CCXKCJ
+@AGaHdEkSC(2VST+(X$Q3!+IN+)K8)%1@e")M#%p02#,Dp!E*Ap',$TEC%fe(iG5
+k5&@m2a"cD0RbrRdKCr-b0TZ#VE8b@m(MM#eTB&-($3NCNG)4'b6`hLLL4rIK2hX
+dHS3[+"(UbZM4dGlm8CV-b$PcR%mQ(8IY2XF4*#)0k,-"6%lVQ$dR+d-+9PpldC(
+pCMdPNrIhN!"cbql2kJ0p!NP$ZH&Il"mkCClBh6[BhpNhf0h@ea[K,VpFb2'X#fH
+BN!$BUS5ma)4-Y2926(jRSR2LV&i-"5+!89kfF,1&Mbr15i(-+0#T4*+pUQ#[1YQ
+%KV,'L65-U$`[)M!#Qj3G,k)6Qm9b0(hDM@lj4QTQfLj5aF+D2UKik[U()T1M%j&
+4)8Bm3bQCap-cjG5FA2X&jm'8iqR`F*D2ReP+D"CCbl"GAL$iYL'*UhI2Y&M)G*D
+bjb!`fS-+L-#TelM!EJhIfP@UT1#@8C+iCNF0A'T,80P$9DS[*!$M(64V9BdJMq@
+#0CXb1`jE+(%k#C6%AGi0GI@3!dFQ0Ee$[0K4AE'@3@a&Q0KD,[B6ZZi%C43Xi1"
+8%aGp@5rkF0aq,`0PDQRa"JTD%8*8H9@0ZqX6)2"2''I$kAchCaBd'2B%BMCba5d
+D`@EETDe6-)A)5rLjBS`f2Ami[V[HdU1k"(I#J$1d*r$1@G(5`b[La`ZT%2hTB2F
+T'%ar@bp((9RcC4`Se#-[5i@6qN6Gd'p&a2J0+BSifL9kC50V-r[0lrH9UF[X2AX
+$G)4-3f,Djj1BLZiMYA8JUm%BD$MN[-PaL)lmk#a9GQ)M3`L9(I+M*cVepXZ,F'i
+i&E3aqM&N(UJ6!pN5m#*Y"3%J3XBre0djf(p@ZkAlc2F(U"$hNkS+AiHU9PV(L2j
+YK4YBTTf%@U2Q,)''(DNVTJ0C'%RAUCVVR&%k"e%bE(+L1LU8f2$L[XiCZhBGMN1
+9dEDrU#f%!NK)Fkr5l4VNjbM39be$TKbrRK+,lK%mk&(#kaB36638q"!Tdab[m4F
+V(Ae2IiDQdj5MErG-4mKCd4jpmarH$ai09@ClN`i1)fQU1SR'Dhd!dhli!&83QfP
+3crMFi,fFdI5@cIGC)GamdXPCXD#L*dl*K4f[!IMj`M4SFS1a[X8YLA,DH+5f')j
+J`mY`l)'4Z$4*VQe$F1q9El4GK+#CDMFe2h&K&e"31hI`D(m'%Ak-)Va(f'9**(2
+&)'(c4Z*F6#RFqL"'%X%hN!"!8(N)'B&3[UU*e!5Qee%m`2!5ej!!i4d)U0efA`m
+F&J[Za4E8h$KD*-%9G6eaVYVA+#[M9K#d"Xj5Ka(UBQBN!$[R`dM1pREf4LED+YX
++4GFZ')Y(AqR[%BjY3L1ThMlfcU4Uem"Y",4`%'JAJ*AhHq,f%EP08jG!9`RkSZX
+(4*KbQlB*Ri6)$b4%e+Km,IS#E5%93#JYqJFrVi5#i-d%&)BfSlIm`R!j$[Ie$Nk
+FDKZPBjd6hm(4iDRqh26-P0c-G&N$Smj-bFa0c6c$"DS*$,C-`Z852mQBQV*!N@J
+JqJi4hT)aVbRA!1"Ie[4'[M2D26K*#`9#C+a`0*a'K4k)0-*3q&dD-[F1hGlI1GR
+I*`8hZ)!&aEK8d2Y0C1S9Rq$iQr8TSGQdq#`pm),[cCNc3l`!%l&Ya-)[''F"(Hk
+bYf6aU24,+N3#'bR+-k()&K3ApBC!IfQ`1c,8Dd"!fV"6-Jb!C"8[ST!!U'")9qJ
+l6rJidY[@1c%CGY"+59Ip&1@lkhQ&'(9NL8iR1B&e0XmcBB")eHLbp4Y[kiD!`@j
+0EbIIH,(jrQq3!0NN4i#!C$UlkahZ0kQJPNc)VdC@VMfdjkmmk+&+iHjPF$0$X9+
+"jS-EJ8CMLa2SrXb6Bh'!8Qp,3FMiT`BS)ZA'fDpaFEPUYcC#rE'BLGa@6SH,Xr+
++3[Tdc[L9k)SVA`-)D#M[qS)lf29fjI9!0rThJk,c"lfS`VF*Ykh-ke*pk24pc`9
+A@5PLML0Ld$Q&HSYH`94KQhV2pRG+`DU%4`H+l))'U[,ee8E4P4pPUlC6YDJhTf-
+if0[Caim989)P(KK028A&fej&Tad@!Ub0+KRCA6SA&qU4UVZLhd*i98rmcAT+f18
+!d-',5!Np1bm3&iNTAYa5BKYNl"39%h"ZFK'"a&a[&A+F5(@e2C`C&lljQH2Bdc0
+a,,SlV!K'e,d)jD#C3PFKXk#cHEj"@AKp$)K"m4%0AG)Nkl)0Vq@SABX5+T@h#)c
+mpFD1Z0(EF#K(HT@"9iGPpqF@E(D8UYe%$8HLh[%54crab8YCIXjk-KEDpUSmP@q
+a5NjJ2[d@pRQEj`-JpP+(,%a*2D5J`LHKr'*Fi1e"pMkLE"a&NVjSR%,&bi['8DV
+!K$iSXiS668!jIQHLTdlh'j-6cV-bfqi`[f#+*e!L*+D3!*9UliP(Ak00fUHX8h3
+3"0"@#6L8,AX%,[ES+deF$2*-MH&Lm`4F-9K46)!)[hi2+3l+jq$B6Ki&bk5,'DM
+c046&+2TK9P&FGQ'PC6`1YT&`j+51Ej!!"AC[$leHbCNlH$,PR4+5bUf"4HBX(eA
+H)K2MkBPESh'IQSkHBqMdF&6fG0!&S4kh60(f'SmfZ*6U9F%8X0'J!$hBSY3!JE*
+-rD5i8E@krK0bF)aB$JXVSH-RN!$@B,Bd['ZKAV&86A`me+hj(06#rXkchDG'Y5U
+P!$8&pb#ekDbmMX!%Zmla%K8VGYPak'PDH+`%F-'ekVH$#A5BpI54fI`&0rqcpSL
+ZpmBr-SEfEA&5)&$d'9$K86d-jj(3EK+r-Q'QEQjQ[h`[#DIU),T$EIlXNb0FU2I
+`Q1SXa+)l,NN8*dEUb$%jA+3d1IFb61!C$NJJk`8&#$QN2b-e+!)dmD&K)N36-``
+63CTS0%aiD@)H&ijZRT!!E1bCjCGVMR"bPH8G(NNH454G1Y@TQ4Lk[EGc02+jATR
+I)'@UL4a6MM+V`T9jI`P6CP@B-[[dbVcrTJj*QIj+b[5[8TPq8ZD-F'815S*i)f*
+e9E,*EH,QbeBIU4(Q0@J`,`2c1a``pf`a!1DA"bFQ4a&5Q4EdP6fTJ9HG*M)VPrT
+9dd6,e'aAETTq8$-a"U"r6`!68`eRmb)J,,M8pm6JcJMh(!(LK4!9@2`ANJMk[)!
+h$PXibbEM+PKXmBCXURk3!'c[E'bC*2TTUGSQ3+YH(`bZpNqLNGf,DVklFrF%!mP
+493IpV*Z++"8[22,D(3Yjj+e%`8q,B4jj++)I1%b40rYBYU%Upe"KBq80'b),S(#
+YP3S1&VcV$DCc95VH[M1K-5LZ5'mq[,--9'q&e$")V11&KFHk$P9()DN[['TLL,B
+`4*1STJS9i%@@DI#!i)Lj@@9lfT&Yhmh"-"FbYSBrF6e0cB)ZQ[+M)5pq`5Y*(C%
+Zk8Tk`3*@H`ZfM*F5%$FiMZ-k0cFI"*DE,,(jV)P4i4J-VfMY8kc!j*hG5Fh`RVL
+N&Uda35er#l8`RI6h6KVJ@%626M6K5BJDL3a(p84&C-M["l!Y5kp3D"GEYFe!0iT
+dQN,aqMbZQY)fEU15qR'4i3CrfAH1'idAFTed&6-%&,%k#a&*8Sfjk9)"[h8-bU2
+0M&'a,!&5aMHD1R5rF5bdS`+f#%XJTJ-$,ibjFa'b&CXkHY!&&d40'Ie0(@35f`3
+*Pm"rGEf#R$(%b"PkJj3DZ53+65&*P!3Q'86aDX8h`"ZG"!)c3XD3!*D3!+'[X+1
+%113X4k@pFV9+Z`G9dDM9cd#`%U"FSGm)QVXHUKj4B8e"RA%&mYU+"9Fbh*8JJQ-
+K*B!L!%"PkiR(NP,3+69508QL"V40C3EQ59MV'aJ9k%!5N8Y,UeVI`-FQI,a4hN(
+0r*J%E#KF"rr`3(Mc(i"%18dkIN%,,Y$a#eUXDT!!kHQR3R&48UaN&`h(9NT0bXT
+XF2cB4!b'TZ4hqiG@d**NedCal6Lr0QT9D`dPb+j5aeSNJTJNrPG90+PA-mK`jE3
+29bPih3S%,e)+"V#a@YZ4L8eUa5DjN[bF$1*QBLZBf'5FLrfDQLEei$k-JN(l6*K
+(Uh!24p%!3%Q#eF,(")mcKAXUXq'5)Q)`!+Jr*B8cq*4G0)@,@[P&8r`Lj594dFS
+ZmF3U!B25"9prK&k'!D+9iE$eZfKNe4IYR"jqd3IDM4M!2GE-VR&kq$9qA%0&3C+
+*MXBUp%fSCfE6K"53!!le$r(@%K1JeJBMY9@*)M,aQD!T&S`8k*9FT4H')[2MrU'
+`%R1p9$#qDK8m@K'ZJSAmNY9+rr@lE'V9PaA,iCGpc09YU(pCXK-EZX#J4$%9e-$
+F,p,%!H%iQf-IIcAU%rpcdSq%h814UPJ%`lNClA$S#"'BYVCp#JNil&&+q$eD06T
+d3"@c4Dj%UNB[M3l&L#h)f34RUj!!%SM[VYT0M(jLh(eTpp$dXhN%GVE)96Bh-V-
+8#8C@fXB85"d3qiA0(HPY'-`5rJ8H0(r9ALphfZ@*N!$qjk6`TqQ6)B&b9a%B$h3
+%ZJ+$JG(!bB!aX#G`16![d"5B(RJrF%GJBk!d8"K+KMbKpY#QN!!TT!RG'mS+(3M
+9KEi+[4LD(DS2h4(D'#S0&3D6`I&J4l!V1"JF$GU$kF'M`BA"fQ"$F'C`ER"VF+F
+hj&9l%pj0hN([U0IZ6IFHpGCi&hKIpml`c[&HkphXhHAfZdIF1[FXYpQpfjhK6R&
+Eh&IGMlJAZH[GGlLIG1rbqAh$2Te[PUr2YpYhhRI!GpQh`0IJQqQEkp[UfeRQ+jX
+U5j6CbJkAYC@G,MYIYVqXUQaj@AACl,,kXQPP0jIG9lE,(r*Aq%ImlIiGrX0qKhq
+hrq48SIJ(r&502KX6CABf2-5(q@ci'Kmkf2#RI$M'KKIjX)F0[q*$Q3dIiF-@0Vb
+6$leX@%e$hbifV1A$c@ci)KrHa)CImZ(GE2L[I2J&'ll&K`eXf-b(Y@cBa)F,fE#
+4$iqai4)q6'2$aAaiMJeIjm-6E,L)$c[Cm'dqG,(KcrK`"a[qNJpEfA!f(`kci3Y
+mk'I$k64dPl$KrqE$KpK`"KmqcSEraSGcfI!rq(!Q'hl#KbpJZ48r&P,UETSL"4"
+6!fGBb)CFaHjME-L9kNjM3kj'pcQ&U&SZ+Tma5!MV$H!hI$M'AR)&ZA[BN!"(J9Y
+QSUUdSLSB!eH%@l!KMb,[-icpTrSYH$HbUijaKM[BF$iI[XrBkr#cJ,22CZ*iG(K
+I9)KlN6-X9dcp+jqbX#2FQ,`TE-JM`TZKZ1!SCimSTLlb+CGLkJ-q43Vi#5Q2#j%
+9$%XiJei"h!bpHJA`b!k5!UETP4GmNQeh'4pHbiE2mH%FG[!IqA!''r+!&AbG$ER
+j"KFS8*K(+!3[BrNHITCcKMd+TG4aKLc&N@0mkM36b30,X)d0Z4%'$bZ-C4PRhmB
+BH-!1VQ5)Fi8%e@ci,"q'f2"[D4MDLH8rka%,2F#',r(K0BTVAU*V3ZmTTKEb+@8
+!H)42e5UQ[X@RDK46mrR8(XA8Ir+T,)E@crR9pc+'lq,R#QGSB`aFqD($$&%H-5%
+EBcp#4XrC53&r)22A'h8SUVMbhfJU8++BQX'R0V0M&*P(q05eLLPZMS(h&FIZj&2
+k!-"4$lbSB1"4(eLZQ1*"*Q"46$A`U9bf[D0F5)`0Vr"KK!f2m'%I'elL`ePX@-H
+(1MEmQ!p(f2!U(dECm!-DLL)f[-b(@pL3!%Fl4if'#rR`HUD#,dRjK+c3&i$FC-3
+,E$L2$jHai6IjF$iErLFISSXDm6iV+2CLm8qXL$'b!99A'8bC90$RXaG8m,5a!BP
+bX3&GZBNG)%23X4II`Q#F$3J404Y30HUGHMrbE155"*cNL@rE16Mc,#AX*CHPX)6
+6P*3U4)Q3!,af5S6)!CLC()#jjD6`YQQ68Br$Ff)dH$ki`'Z5rJ9Rmm@)Y`F(1d5
+!(khQ4q2S&1mDlG(TBS%`#ifBKKilTiRG)PfF&jG&ShJ4`j0L*T)K(-"bQXJ9am3
+*-8GmJX&bdF!RTiRj`f2L6P)X&V9B(-ALbpJ"I&k-TH1c,*D,6e2X2$l0XC2i,)Q
+G`1Ief'jmIKE6i20#c)(2rileiI-IXF2iI",V`UFqYJ1Icf,Em*NCDmIRqc%CRcQ
+a%A`qM%hK8aLV`+FijXIRX4LmV09)3ZNf+cBYJA[l6SU3!%i,lLd,c!9BpcUfA!H
+hlCV!c@*qi-2!YB'GJDf"cB(5d%T4(I)&5N))@+)TY$*3!m!['QS4$D'9'&T%[AJ
+1UVK'c"8E!r2&CP%XYJ#%p!Fmk(0)$ZM!C!Zi!%bD!rN"6H#j3(AJI#!'S$+0#rJ
+#b-)"2$!2Lb-81,%iLJ8TNB)*+E%+#e,M)5a5X$L'a6NXAX1#e&L(a@NXINU"%iX
+V@*!!'LpKBF)#A3`'PQ,a-4DNaUYBG'$a!4B*,'SSF'*a%BX@,*CMNF6L*5a#@#a
+%C*CJmEGB2)2&9eMFKm9h+A"L-4q,Ql"!Pj[L$LcQBI%K&YqN`)R&)eM-`1*E@-c
+'BJ%@M9Mm"SYD,0l#JK5`#!Y5`0[-L,jJ4[52h)MqL4[4hGb)rS8EdEAFL+lK4[3
+%0k)(Z"(GcieS-cHLhh)MZSmEdDqj%6h%MHKKEN5Ph)Mq`)hS9pb)RZ&'p$9Z4$[
+e4K6d)Z()cq$@lP12LDp,,ZZK,3V$@ZkXS!i'q1!9*jVh1$k0LrS*&h@MAP4S"N3
+YCk,HCk+@+83GFbBJbX`(Yr*"+hlDmG1$(b5dFXSa'd6ZiY[i0Yr'Sh`E*A`EfrN
+f#[MP4IabPIEb`lLmQ9hqlqcb$NaDf15rXFPKrN'#6@4TSlJ*HBGEN!"mCLX51&@
+MUfUJqYJPMR))LEb#K+VP*563kTLNKipdI%kI@C1'cqJTqRJQ$4mc6BND2V$44eb
+QBf,VbaE1h21bKErd5aqZM!qTfcGD"PFk-rKL)cQTmB-[5JG%&BkRk3GieIDbjAX
+@C`SAm(qGqrR#iqc"Uk9J1N`6Yc`"CM,`HULUQKRU[c*$E@5'ZTJCDJ-ce0R-8(r
+*$(8k-p5IFd0pMK[U$'kSrm!0pCqjSEl($IA(h&$RFN1pLa[U(Ga3rmJ0pATZU(r
+LK[VI2)T[iP&m-irLrmZMH#12iUdmL[mAMq)R@45I3$6p`DkT(%R4Ci9irDKc'em
+FFDkNaCIrk%c5SVBDQGiH#0R#aIk9LhfFLrd,%q[M(5%*4GFP5%c2(m%LN3T!*K!
+VH6F@8AZ8Z6G4mJ3EGAFL(5Ni4XkIVF`4K$*k"Xl""Ahq1qIJM[i)%R6AbSlDXPQ
+8iAYYp*bT$afeqBc6U"K"ecepk,M(K13a(H+`cX)A2Hd@5ZU1cXdI3@*i1&iA()-
+$f$,UD$SN9)dm8ITX'RS&Gc)r9Kf#m,4SVRP08FLHFYf(F8e2NEHYabm+jYPb#fS
+6rY%Mk@ZID1C*dl8LR9iNd@p(!XCMjRUU@-aVR0lpdf)YVq3@,")fhD+#kHf,#QD
+6'UNkelZS8PDN4kE(#98M*`$*'Cp&3XejZ3QSm9TN!T!!FbLTY`J%N!!I0D(lX9L
+&(2cA4#X5N!$*`6ZaN!!GqS4T$$53!&c'Q[!UL36)DY1lR,L$EQpiBLSm*U09d9P
+$e1p"Y#%6h1qm0m'kEBKj@pkR$Zr3@8``XADQaEi&$Uk(AUh+&mCir5(l6VcDJ5i
+N[A,SXESULa`bZd`Z,2Ter6IqXblkbrFcTZ5CiIpqGRIQ3b"3f``')irP+,VV3R3
+NUBX`HL#0[U-YEFG2QkAZ+T!!1,9e!Tfr[HTUVF2!c`G(@q[3I9-d"afZ81H)hkl
+,ljBGk0B&(@AaLI2jhE%LDF2IbXl15-r1IRR(2HMJkiCl6Kl2b-j-5mddNRrMi(k
+TmeEY9Ci0&6pI+Il[`L3,5CL8i)55Rh$fe&@bTh8Hr-m(cam[KfQ)Z$M6MXk$#j4
+-P6E&1FAU#QcTr0d8',j&ZZYi9PC1+VY'3UUPMeM$8GHb$NPUeRGi!L4@6McmNpE
+@1Q6&)1(VGJfKFU)ladp$#49P4dTdL"-LLGNX(H@GNIM4-84hC9C*r,3&@['f$4#
+[NijHTrM4heRmk(@,rjH(p1),a(U)ak[#BZNBlkJ&(5RNVdMdILCk4N&d[862+$J
+X(3XA5J8'%[Yp*"UGRX4(BTNFU'N@YFp2L&Uj(dk&+jmhL`@V)G!"8D+eMMjJDX@
+$fDDNECCFXf*Ni(LX*d%[,TP,Kk9NRRSa0-4e8j*,,a3l`V0@Qd3Y@bbMaDhNQYG
+)5d+2(9V!$e(AF4D*(CQdZ+E`2*,I&&("bbCVmA#V"AKme8JR1M5$ZfU4JYR)UcR
+cmf#6VQ*ShkG[U$NkS+5NSe(8fVdQ$2M%&,U$A""T&!YqT&'T*KYj%fNqQ%EXh&"
++0ZC6%[%D)ce-CDIjR"DY3Rf(@rK433K3QN8S&6)QSf1)R214c14'jk$N6LZ@jH2
+aF8Lmk6"VH)E[iK)NPGpHajcZ(i*C@M4J3DC`"-VR(9C+M)m@Sp*B53pUB9f!X@S
+I6Z)CFQC+5Nk+I#&AlNe,(lb3!*ACRfXmQ$kCMTGj5jF5LqiM)Gj!+E"dUECFHZ1
+0AX1k[eXadQE8-28K5BlDTZqbVjhF(j!!%+"F9HkJVYrE1d6YG,"NmBlJ5EQ*fkP
+53GBq2RG"dE5i+#Pk'9Gd#lUB@mH9[CPe0E%Fh4dJX5pe-##1NL#&iN[d(3pDebR
+8AV)#Y6p%QE9-lAeFlEX8DYr&hCm0DXpAU(fAAZfbp"!dr`BS22AmmC51EI+C#`F
+bXp-rfL$PU`ST@C!!P%%Q8hI)0A$P(XI$lQC+#4ZfPqC,b&*A)8DHF!U)VAE&U61
+C+8V*,%Y)c40AD616eQ(cVRB1*$T(@QrM430!(3kX4+e"RLJ+'Hab8+m!#9"LBZK
+i9lX`UUC6&bXG2aT5UCL3!*8NK!)'G6QP&c0-j[XXQ@qB3)!KBCPE"T63Z3-K`96
+KekZLj$P*&592-P@dk&8K-p"fIG6",[D(E@)(1R$L++pfD4qle2JhZG33"453!*L
+bTMl[jXlj#T@haf(kDSkJ&%NaZXUJ0!K+)kG!5@AbQ`P0iJ+b!5mUZmZM`PXr`6Z
+qj8Q'$0hQDDZ#GR3Xk#@R+(50'c@Iiae`Me-P3*HZS%UUG)'KLK+$$T(IECF'`rR
+G+&#4T"l!61MLR2$Z'(Q43SpHpFU8'$k!4c[kP9hqmDcL*Z%R0qAbUXqI91ZV6c&
+bhG8R$[AJd-R@1P+'l'!GMEG+)Vjqq6SfV"Fb`P9*4C9r[8'0'D*&3VF5N!!KCFp
+R%9T50FTF!rd-ZD5K%'BURb&14f#Q9ZV-YSB-N9A&LSaKd8%[+KrA0rpN[rT'1al
+5U(`KDj4$)pcM("jlLA,5USE!68``'[rk"J''8l%S"e)A5b#UrTMK!AXN),mZI01
+UK5Y39)9THEL5&0A3CS9UB&MPAm`ZD!qE@2cYqBE(9`TY8NIq-+RjC+j1If3*&(&
+lE"$ZXfQ86!DG2$l3DLD$'1LQLJB'5qUhmHTT*@IL8i8,+F"5ac,I0M+%dUJK1#l
+#'S*4()%5!mHS-BMU+FS,20TbdV"GrS"2EGHiV5pCA`A$9r6!Xrj5RLMR0J)QQ3S
+kT3#$JSS&AKC`f`()4H8@(TcAB*-Gh'`1m'j@G@')58(BXL+6*IH+eTS943HL1&L
+rL#IlmqmqXY`L"a4-86,RPKSPH-U65@26+A,$N8a[E8m-A83kNiQe,GG-@Z`PL3Q
+j2m`NcdZ9'LqNefP4J`T9adJKCd[j#`SZ6#'U`q8V4$A-&8,E(eGfMNJ)D3F3p0X
+k(UMdTPfL[jD5KUTD$*F5k)&%84XT-1J[,jTCrZ9&mqKbFpj2[Lp&3p&@-QqTFrR
+fl$pr-4b1YQLSM,DBVN4Ea&CJ3TXBfZmcifNT$fep01qS8DTaVN@TaMqV8A%QhpY
+)S[J3d#cCZFd`q2UpKX(A9PBZmZHU`iTmJ(45NIq(HGHTA(+qQdBLT1*C83#CVkZ
+SCS@aSB[D0*9+iDkfZ%5R"DE3Y)(ce&9&FGi9&KKdAQr5JJf'&DR5a@AUbX9di4H
+V6EfqfY3mrC68LE-5p#SaPeI9cNhA9lAS*QfpUle(ak@MUdFi(PLJ0K6*%J'bRES
+TECPHP4&Upk,$UKRE(fNAH)bkGrUKr1k-#"A$lHI)j9-1'SaeHjHLZ&XR'HcfUpU
+!Y%jLqlEQP5(K*411DI5&G'a`qU&8NfieN582+%5biR2lQ&BN#jLlL[3LP3RFp3q
+C99Bf8RGC$3##-Rd!JY#-C&8-,mkf(feA9$*5*E(pT-iX4e&*Y2#+!aG5491bLaJ
+*Q(,3BmB(UA0(#[`P0KNG!U,a`SX0+[,"I,Pp1DqSC(l91ZQbVppA6P9eZl*+N!!
+PC!&bM5T!,QAaM5CF[p,-J35""Ld%NNJ'T0SB*JkG[P3f[k*V&DjJ[$XaFNq('eJ
+J66L1jBaEN`bFpA4HT!l-R+%VcellE+6UZ@0j6mT`*I1Q9HkfJ&GdDh"J4U"%*h3
+!UP[E1UEDh61U00dRdAASYFZR9k8@ki,cPh0@G(%XXB[fpZ4AU2LII*DDR`BJ@Jj
+#ICl`VJZNak$f!&cY+'[VJ8Y[G*YEei'ZTU(fqFG)13e)H*943@$p9dM)e&CQ!r(
+dUd0bbbPdRrMBiQhZkFG1VVcf@856Ped9lEbBm1)a2HK3MS`mG5Z-+ST(QkX0$c-
+e!-VFL03j83Rd!2)*6IIq`(Z0J[jiJHM@1K6PC"jU1D`MFhf(EC4i!mCA&AjpZ`$
+4`bmeI1b$8Q,@,6l@9$l2QmU&LUBb*h8SQXSCLUCbSEDT(*6)%a-2hcL+ELKXk$F
+*DRUXq9QJUJ'#cq%(AG+Pk8RP&kMP,0[4KTBcFc21b!Gc-p1-QDRTQ4PC[pp3NJ8
+VXU!3k[)3bR6aSEVY()Cq+kqL*UQ+#J1lH0AP4r4&-hbd4-HR29V``d#b(HD%Had
+9IrPKa9mi)'S3ZdpUdK&*SMUXL&JN94ermbZNScc,S)9IT`mkrXk,*bSAZAqfDa8
+EHfl&9e$hDM5XVe%fhmUER(MiHTHKJJfVjKmZfDJBE&B-VT'1rQNXr+LKiLjq+&c
+8GU%Bq"8$Md*X-3Q)Dk[[3%mqIfaqB"BY`UYd*0rJ+[`&NAKhJ)M9DZF*pe&Jlm#
+4[K2GH'Vk2ILKB39[C#33D-iKD#9id%,L#e(0JP+(RT3JUIP#cTRXNmI2C-VfiaH
+b3(!L3P0U9ZEaP08$"*r3(eLkP*d)$a!F$,Uq0,cKqkYY8SAq`-,e!B-HQ%-LbQZ
+NrXTHZCQ**$JlY"&1LC6a%$JNi2FIYDJ$jEfBUAM""0bM"Ilj&LK+iM"6e5)meV%
+3$aS2)hic-[+1F*30S"GV8,5Z"YJi3$`-mDCY#LGCE0Xh*J[YC#I[#R8'1RKc8HB
+Gb*Y)LS3#0)3LX"TGEHDZ5'@84FNII-FhC`[E("+PDEZPBGdm8%2K@M)`BSL6mQB
+8SF-93a$4"eC6#mLX!CkP%#+!3B[U-pbm00U*1f4rIMFRDNX6-hR$RD1YRIa#D[C
+1I5+S@jRjK)MqC@%KGFSUUX)Q0f25U*`UDT%#4p%1VMbH2&RlmTa%+LJkI%*lCF&
+@[NNpbj4d['!R4k6#!*U3!#ND'Y+9#M&d8KP'()+khP38*HVb#QiY`@CldqUJkiS
++13kX)!miR'4'$dR@NLKjGb'DFXN35P,&(l*@4+S`N!")&#5mF3-*cbK@,h+hKa@
+jN5EH5Ber0G1H3Y%i`M)8bc951MD*ihEUe-C2T,P909kS3RbL6Nm3[DYH`D`NfYD
+[-JKU!H2+4#G%rEXXdFGL9GUU%0N3j-)[B@5KM"@6[4`eGRpNmFq2b[5MANfPRJd
+L0!iEQ20Aa+arL!3b,C!!e9&KEH%C)**V3$5-3&#*e+SP6#X"p)q%&fUi%+B#VTV
+`"MNrV#irSSLFpp$JNh8V)+cT0eG4[PP40EUpQ+V43VpLS&B-K**`N!#S+GGd0ec
+4L`Yd+eDd[RNYCQQEeiB0&dP0'$!X,["VY-h[!PIP+Qe&D+V59j94ZTjAUkrlDTi
+)G%V+)Z30VYdDkT5rQ,Rkd&%L6+VC4(3&JDBb3ELmL'#2)m$QEYB5*IAAJ0LVk6C
+FSUUY6*!!U(ajH@#K!5(9!F8@&GHS&S9GFrGU4aFAb+XX%[4EHrQAFaA9D#&,a&a
+)P6Xle+*3fG+`!29bJJVArP8@D4T0hHU)&,eBrVE#P9GNVe69-,8AI9M1GVY@S-#
+TFVE@`9jf+EBfA+NBG+dZV+"d"C&aEaMDVZY#6kPmCG@m@RB4L1m*KG1Cr2)EEF+
+VZjLip'krm,CRk`cJ9*3kP-GeB39C@'5-r8mPiTLXAV8aP"I*8N*VrL![55@ke32
+CLU)r2"*A(3$+$hMK38MerJS)U"ikhPVc#PJT+f"&C030)l[5(hbM2+#D69hm[8+
+Ge95ka,UZACq002R'"Bi%2[*,bNF1PBNHUB'!6LKEH3I@(B'EMQipY-hp481@b23
+Qh,&3UeX1e4`"iIp*15"eL@D)PPBkIN'JUfdEr!NISdT04i3%R6LU)!Kc&8UXZPX
+AL9Fp90fT0a,llKXX)f%N,6LGP&HSEYCA`5M3pdmmr,mq*&HBhfj$KGckmcNJHQi
+@'Lb'D4+$DJbBDeE"CK6d5HF1($)4F41[afAH"'I0Uh&Lfpi%N!#jN[[@kJjHqSV
+Hm[mUIEVZJD[@Q3ZTf83@1AR3R[fJhUpX%hN9C+HR(,q3!(i'dpN'al+`c@apIld
+h8kcIc0Er3jY*,AFcUGV0'%!M),CliZ((5N'3!2A53P1AAjH)*1VD)r6iSB[rp+j
+C,#8dm%"X6!"Y$pLZdTqAK$r9aX%GJQL,FdjdEbLb1@Hi*mGe+Mi-fG1iIMpG6iY
+`C219k#DN+3A#8BC`p(G&q-,[JM#8Zh'QT0b0-pG(Z4[2rcQ9Zd''!19Ze%M+hDK
+CAq9bK2pXbPd2K2AS*ZKbPQ(#Vf9JBU9VqDAhK&hkpqc5R$-EH1&M9rqQ&kj()D1
+rd26R+5ii3RqR4'M6$4*#NXlATlJ)4q[285#[$eUV9TED5Yd3GKjm*#-Rqm%,'CQ
+jHNPGUHQr0fD#F@J`9HLGJ6aGE!0pb)`+YBm1Va%l2-%8pj`M$UpGRV@'R2@*T#i
+,kX+CND'i14FpPeq11HZljE8FCTZiCi1+YPPR-R268hiIjSDY*rH05aGYajp589Q
+9($#4P$IQc%b(Mr([%+P$repHZm)YmfZMH*SCCG%KmY"4*$jViG+0#-`p$NHr"mZ
+*`3FT#ZNKEl1Xk,*T+!$3"NN1e2`23m"$X%Uc$MIiKHf(q&1fiT+Sp*bXR!Fc8mU
+6Y8T4@mS4GG"SA+%SAM4iqD0Z+cMJ5RqSJ(&B)VP'di3R1-HLpK)`I!)LGGaac@+
+$h!YRbK%TQFm00QQ+L-bEmSkIZHh"5N@3!$cam"2Mh*RGTb!pP41d[UX-@GU,+!V
+)(4p"GkQXIYPbepXJ'-#*rF#SF[TclB[r+TIp[aV+CpplSM+bpaHZ$l+@GjABlVJ
+RqfaQEQB+V#Se*b-cGAmk-%IC@8k"6&HdrPQZ5!frJX"Ur+%GF1)#!$a-jVp#GaS
+L&0!9Vkc)LP-4[CUK92bIUNPPaGBUM*li8e2,3f4U[4"jIJ@PS3%2M45NJ%L8rM`
+%C%jDN!!!489"34fFH2Lq,'S'i2,!US08+LYH9bcUeq@)+Lp)k8@KLr+$&KhimSk
+RC@GPjMV6cfFE5T1`U0)ABF8%[!c33cL+HdY9[!01+%a0McIP$MPi2!!2Q%fbQKT
+B$!$T`5AAG8&Nk)+NVe0C$,8e1(Bmkm(M[cq6RCZ$VX,hVa)lk9!l$U(Ih*`-p!q
+f5RjM%1`$B$qBHqEm"A[k+M#lS%%F4RJd)L"1b@r$32"R6f$Ki@*f8#'6ZdS*I'F
+4EJa-9VQLlS'SR)2T'bK,9%lmF2p9(NM9kaYF&i3P@pT86L"G,e0jd+$HPlYlhJD
+`JMm'iL)H&iJr*m)Vrl#K,XXlmGmalm3I-)4jA)GK2&LZBBMe-i`(0m``(Y`3`hL
+`(-1S(!@EcfQMS2"[%!@+JKJ!!$!$384$8J-!9V!293XX+3!UEA1rPhGC9d4F9L)
+LSK84dG5-FF`B4prhhAh*mm[)6-e-3FiY'!(#JQDQclZl!L+HcG3D-kGa(-GTc*V
+'-DHJF4bRc$br'XFm0jil*613!b1NjAkH"9`mGp0mrqqk[Zqlc[0Ge`8E()%%34!
+%3C!!5)TN4#[@eGApC[e6qRP(X2J9D-%cB)l$R)ET#X0K3Q%Z`h5#kAZ`cA-UTXP
+0#%&4j-RGTh+cJdGENZSd3rU&)H2ceE[UC#-32Blr8LfQAbHedcc5,+-fHKPr6ce
+!(bI0dBUN22SJk90YY24EBdbdQFp8CaJPdBra2kL2d(G*Ll4X+Cf@*#h3(TH@'Sp
+'Cr(&DLP06hT$HeVkXr&8G"Pr6CeLH+-2mUPU!8e,QUfCT-('kHJAk[JpkVrTlU5
+"@U9dKSBNhDrG+6eJr$2k,"qN(U@DT,Xde!2M423aEP9$M2,S2r'KkQed4e+`GPa
+US*5NKl8pdN2'mp(lq("eK(%UqMPqVhU5(N`DUHfAjKSjdA[j0qTZ'TBd5UZAFQP
+qdN,YN!!dccJFEH'4DLFM2$UUMMqM*Y1rNMTV1k4QkT2dGffcp%FM+$U"hkjQ8,q
+N[fV[5(mcmU-cq8pUIf0Mp1[mGfS6r5@TVpBSlD+H56rAIT4H0Gk1[X"lUjmE0k0
+[m#r9EqNh5GfeLp)RKMXkP[pAh8,r5(TI5j-LU%I5KeU-p)1a+EU9pe*6kA,5VAZ
+dck3"aPI4+rNjYCZa)RS9Id,pRTj-kU)YPeifYN9ra2qMlU4RNcTSfk@Ye$lT&He
+0UD2a9[4UhP800Bj%Eq$AeE9d*5P-@b1YSkY*Pl3[T'['ep(VHC[U)QI5H8fA%Sh
+lSZ0i['ShP'J(YeP8bDBPFFdLfG$d-*6q"XNdMJl3ih5#EP#G85IAMDXl82GihBN
+k-RYU#r-#4FDBiQAbk(%(9([aM0'kYYUXDa*-Y$Q1)qiDTf[2"h5YY&MADQ'bB"k
+"'3fN#4d,1XI"9!)cBic,2RT'VFYZm$bA2F"(ZqbbX!FiN!$MK29`,#&`KHa8-"m
+3GTb`BpMH'E@kjS&NSe#h&1VD1&RAC)qZQBXP)rS1[Xcbam5936&"%@P"#CBr5[D
+[h,'@j[J0ENY$mTiA,,IClcb*i$aZ861L,!RRQM)YArdBi`jk*fDrC80QmURpPND
+,@fXYYcahH)[Y9*4JDQ[+M2NajK5b[1HBX,!0lZH@j@A6X[XbJLbCm4Be0XEGP+R
+mVd#GfXRjM4Xh,3Ehk0a3,BE&Bc%NZiI38d4dD"kb'-aD2+V0)klk#Kl0BqMFSeS
+mm3B*V%I9$!rN#dl)`4#-U,(N`3$'bEKd)('Gf--04m9b#[H`(@)aK4XZYK663,&
+"QU&L&Hjaf$e-)'F+SQH(Y+TP111U2ZCi-De@5cr2HKiAT#Ck1(*a6PcKA(@L6bE
+AG3XhN8"DZ#S'A"L`f'&9ER)P-JBbF6@qJY("ZDY#!$FT0S&@ZF@PQEL5@,(Gj0#
+!#Q8XBVGkRUeJ8Zdi9fb#448V1%,CNK"[8EL&i9a1*J4VUebS40AU*E)"Q&ef[iD
+iYKr'Y2I,8(LKa@`TG0R0K@3a5ebi'YC40B&4m@mh8b(b8NZK$6dJHD&$l0,&4Za
+A,B@5CLj8R4"K*VEGALKk+Jl&(V-L@$NNJ8-4NL6Nc'+NfJUVK%YLQELUG5[%J!A
+lH,9k9Ia-#U)QeQ%@)P@KQRp&95M)#aA'C6(Er*U"9+,`,CS`5KXM%$j4D6!#$bJ
+#169'8M"`c48[cMQ$-"3@5#[SCl"5GQ#$HYi[3*clqk*-eAJQ&b+ZD&3KJFC,2B)
+9P1YqGVEE+Bl(kqAdEqCDaDTfSGeeLe'PVG"8Y9NU#V0#'lpmP,D"e!ZMfK94#8"
+QJb4&%aM*,$$UY8,SJ`'"Ja5cBM-,&K!,1CdUFVYE%M[aQd)f`'ibA&a4R%bm`K@
+(jKFReP(X$1PITdfTN!$2eP%dl)iAZi$c-`U8(E*9XE+LR'I,X(a@KGcV99ZCqJ`
+Gb[B,"k,DmFVJJ$)@Lb6kU$fX5j*UYm"@$%#0kqMJM3%@98`bZH,p3p31`5ECa%!
+*K3aLaQ@4Q#c&,U&Q5"+h-+X)XBlcM+F+,jD!$LDK$4CcqKGK'#C$Bkc`N!"+K9#
+A6HaA8$0YB"9ic[5SdXP4XCSMY!+$K#Ck,&6S)A1K2X"-SJ2J,r4B-,#)JI#JSX3
++2BT0X)UU"cEe#MYQ@q&BlGLLfV&&D)Q"!h8KP-N4mKcBlV!*Q3"PXb$D*E%5-i`
+ICAAH,diiG-BLT!NC&HSSU*8H&+q(M4A)ZFr*4LiR3cRX3JqE%)S+UmC$Q)P-%R0
+5(RK#MdPLRY!%1!%Ki1SPNdF0%`IN!Gi$GqGK'`6&25UM)3i8*q03Vl-G`TJ80![
+ZFl+4R`NCKq"5r"'&j4&Pi(#b(8,8HE%m`H9L#a2[hqk!DN`R4kKI%DTL5!5Df&&
+mKBV)S0M+m2&q6N@XJma&2RbU3,XIlb6hpe9q-JjrMbDD[LXjU0@0E`L(kE$230r
+PMQ[+#0U3!0NDkrl+(4%8pBjka@G%"GUXU`kEi&(4lqbi0!'li'L[m&,%[JjM9Lp
+dSRe`aUcT3&p!Ic&-X+jprdQ"9Y-!JjHSQZ1UYLS&R5-`UB,"bdHUfSif'$F--UX
+9r@2F#CEbd+!UPD('HdFGeeSN#8UmYpjK[,FFR4d`Q9MRV$TJjA`P+[Rec4(jXCN
+*kj[3m-`-LP!6Ul[JE1qiT#BhZQ-c0eHKKDcE)DXI1Yh&`(K[*XEak-q'QDYVbaH
+TIhPVY5[+(395Z)-LI)Na+8V3`Q(-m4CSFh,%`*Kc'[*U--D,j*ceN!"h8GAH#PB
+6hqU4'T'r15,)%R0ViQ,BeMQ0f'D(kBDYkDUf09TpBZZ4mGTm%H[f+FJ@3qck`(&
+V)R`iQ3(4NHJ-%J2MBm+i4i(fX4NQ5pHqLPDe0k(RQfF,R%-M@B(%Cq4[ENVH'@5
+*d2)C+8(rMiq#Iah-9PhEeNGeEXpN[)NC3CQEhBf#fCl2#,cHq(JVq#2!ki6T#[i
+)9GZHUGS1Xbh1(9%*1k-X'IEmj-2k4*!!URe5S2KiNH1k,d"m2"a,$%3(Y*i00lk
+MUqT-6TZSmS*hYUA!1EZ5REIPalThjMI[M)M+h"c%4"QcMi%P$T*@`f6S@[*L0A&
+lCP@"$G$6JM,G4f-cBjSfCq)p+#-rFr-a#*lY0'Ch0N)XMSQPiDSD%418fC4FpAA
+2%K-+kMJU"VIb)jK89e0-Dj3lZC%"jZa)BhB)0*P9S%dVK#Nb3U"3b#kBF*K')k4
+eBNYT#YkMAJQ+#%V`"DQ@i$9YQf1LB$HYd@&-DdA(,JE'Y+XBSl*1k`E6h`M"Yiq
+3!-X&jd1kMQhG5f,GP`6+D52'!T66DKc'&%q"0U9%$)`T19JEheqQl)H4M*!![PL
+l*dad`6-K[4lXDE0-k*GDTQ5+ZpU*63NeTR$QRUBJ29-5d%&kTL!p-haG%i6lZ+B
+TrCPVfJK!hEJ9TVRJ9NLNN!$i8URM8ee9UdiY-kB@X9@RCQ(9%HM!(d`pES3%Yeb
+e4LV3KTEi9jekh,rU6*KH-0eKEXFjkZ938m'c3bILEeSQHfTlBfSIKc%9"6Ae*jM
+HaP#X-r4i`B#KdSY`'&1('e1$XIqe!Qdka%f[0BC#VD'!ZU(K"GH'4VCFEITqBrT
+aBfLM-E6ekSB[aPI'55[Vp2#@PA9kUm1B$MLHEKF$BcV+C6TmqA58br6qaY$3kUU
+Ef*3IXh0(9%`3DR&c9&0'E)3J,Y[r,MU,B%ETfZXG9'Gq#GYa2L-r13TI$XUGc9(
+*3@l"E6AHm1VAmUp1N!$B0qU00miD3fFE3`%'3b-92N,K+a3HV2"I+2`r#Rp@i6m
+TI,r#rkV`pa5H`l"pm2URm"+&recKcbMFV["BK6r-Z,pAH,2#0bSmAZ'E&,jBi8i
+QX4X,cl$a,SAr3q'9M%p@q%,4"ZB&6#MD+bk&fe6aZZPJCeN+(mc%JIYeK4pJHdi
+be&-+IaYY#i82`IXKNhZ"V6&2iIFU[)dG*#TmVF,rV[$j#YqLm"#&pf3Yr"&X(-h
+5XdF4Vh1lQFCHK8HbPDBTr+,#ma4qAH(I-N(YQ)T*#Rp"iAp6q('Q5U2#(e&iQX*
+r92J*KAqRm&mbe"QQ(&C0VPU[PJfZ-%@aq3Q&[k,`2b[mNX+A+RbJ`[r&G'TMT,q
+0kI3K8kK!i88XY3T,*`UMRF,2+I`YKFpN5dT-J`5&Im)+)&[K(44Z9IK1K3F8IP6
+K+U2)G)Ah9hKAPQ#8jH1-lReCfUBS[*2#"l$MHjQZS2k$M$V[+[`KPSD(f4U(@*V
+6&EjAiDX8[N6KD2*mV2!E#[p'iEhCBX2CraQQ5J-M$4+cR8(-1NE@U`TIc8S,Lpe
+LHQ$Y9kY!C!1Mi)mXNAFceLm8[P,K,c2@,BckqaMK`$TEi4d9rM98Cm86$PN-HQ*
+C1FeK6"BQHK8VM`F8AUr`ja8HT[![@3)J`UE`X`SIT03p49b+YR3+Mc4G6TepZPI
+VB(2SNCN0I4Y65VUZRR'mjkjJMp29,ZIfK,QPACC22rZ*He"YfrTCqrYPM-akHG[
+LSpd[eK6DPAGc1qqBlcfhFNTPMiL"H@&V2YMAIq2`l2CE&jAh[K!5L)qEA0qRH94
+CYa@[RANrE8M4eA9c6[f815+p`rBPackr@@Fe0$ATm$04m`TZI6EYK4mfh62QqSE
+Il[P,dm12GAcV$lIpr-FlLXrV[pllak"[RRlbqcIqqGrB"jCGqrUpNhppjm&(rr2
+4dYrrjYZlC*[M&iIqPEc`i)#[T[ll`jLl4epCqqRc[h[pS8GHHI1l2lhkpY"aLII
+pF[II0`plkSP9Illc(e[Z2h$TLiqIqe[q[BmrZh2"L5p[Q+iT6HkAD"3[5TKiMVN
+)cQJ4I0QL-$%`&RA$',jX83HB(XE3`DUfH3GFYq4BkIKhTDm2SJNFdU,)X@5-LdC
+!jT!!JX6[mTJ3,2TGZV&S"&i&N!![I&G@d8&fZ@J11XJZ[cYLI)GXE'L`UNA8`a6
+"C!XRKe`'ff[-"HGV6"Aje(FAMHrX4SePdN`*1H(PQY4*@LeGmb0!UDrc%i)bD'Y
+342iA%3P"%@`Xa(hJQ,5G%jmrRQ'4`rKZ2MSeBQ!X0Q1-I'Ua#5E(U-(9P4SdZQY
+%[KbTDXdheF[0amBZm0SN#LaZ0KDR1Bc&kp'r#40Qe&bH41MjjQ-6DEj-4&SlBr&
+dSfCQYB4VN!$JIhPJE6A"-mKB@QM8$(jL`TF+RhH1TIA'8M6NPjDK$pSZG4Phd9V
+IPj+P#FE5611Ze)QejFj9*$mZ+XEp+l3FPrDE5%(i'q0,*d-C3-V5q@*J,!9d,Hf
+#rT!!!Qe*RR&A432c,YE!4+F4VEh@Pp$XUicm,Eq#CNZfM9@c*5Lj*5Le*HI%`&M
+5!@-AqReJHKYhlDV3M&GS&PT`+D6ekkKNRjE(a&i6PJaXfI4B81J`&Z39A&Y3kYY
+N%3I'!J[18!X@R+dB'`Z13!N3DJ&D33XbM,['[e+%9M9-a&kRXH#FFGG-KhrpEX$
+ME3-&,#V`dH6'U)Mp&RCd53afZL1LQY`al-"bV%TRAhQ,+b5GUj!!P"rcXk4J&ej
+T&Z$Y*p)L"XM)d%Gq@@XXk)mZ8K4j40FZEK-G,bj@D2CcJN0hIP[VUh6qLe2D[iE
+C[iECL(5MLf++l+eVErF5(5m29ThfLda#ajEdf1)A@#(qR+riLV0UUM`jRJ![DTZ
+I$22`jMd[VTS-meB+-N5LT6K[+``q&,a0SZ-R3i,J!"PDk*VrUqKD63baNYQBeal
+G+6"SPPjB,MTqBUaM3VVk9r![X#1fq@G6HRl!Q&qZDpq1,0#Xm1P@3+)9,XdDUQV
+j+%iVkUX99F++qQT&YE$LeFfk#brY[Ac,Y4QqrX8Y9qi`jU-1cNFacZqZDcrL2F)
+DAE%ZR+!9cY"+2ZX1KX&,NcA5[kje"T2qbS6TI('Nj!XPBb&5Ha0["9D3!05+E-%
++9DaipE2L$FN+i,EL#jF9PG5+R-S+GfVYLQ8Phq+V5Zf,,,k&520#T(RKqc$[iR)
+V[J&CJmAUAQlf)KqmDh$9dPlHi18@,aHkG29f-&@rQe5mQ9K`Y6-j)bJUJJj2i)J
+XKqeMHjfa(&BQj[LI"I@D-MGEN[2a658L0YQG(e&ZbE3FXl`6Y@YR601&S+T2*j1
+ZdZ*V4rA5ilr*-(4&(C[dG@PZc`VhFb[Cr@0V8"@aM[RIkX)BYXT9c8dajJBck*m
+lbf(-R9kJI32d0k@kTPP96H[QjALIPEcm#%EV[6`9XG$,9k[DM4)[$mG9MePHhRL
+IE4mjD,GaU2!d,SHG0$HFhQ[1k96*Fm`jiC95VTNE0flB*l,kU!6(f")akU,$G`X
+$F&(BSpa-fe'A(FBS!-iSrjI'6M[[%cNaD*D-R$mjc9e48IbK+G0GjC!!fLSBUP8
+BB3bMm5)R&fM$-"L'lfHffMIpHlU165B9m'%1rejM'$i3$%16CGK'Q(KGLmHVIh`
+#6,DURCm,mck-(DC%G6T6Q1$E*e'k'YiRZJK@!)!23cdG0NMAl2dVp'[r%YY9Aa8
+(1B`8I,j)J@00fD&VSC9HhYA,1kPDBJh-(*Mf-!S-h1qScidkVQV1$Pi12q9FlZ@
+A95hcUUVCKX$-8FrE-[pR`(Xq,8M8#%YjPqVk)B6iq5aq[[[%Ze`THfph1E3mrTR
+4Hlqi"&ZJpGlrK9'AiZ@$iCU0Kbmk0#p1AkdiIEA&k5`(,T9qCR5[11hZHcSmkdC
+UR9%SHiS$imaMmNEA,LXkB#V`(LapZZbTNXHb(mPk02eabq(F3cPlkhFhl0Rhr2k
+6Tjilr8,P[mrqmmbGafmVrp24haml)8AY5%i)DYlFf,6apBah-[0E0dA%Z'26YZc
+kmF+EfclD[M0ml!a[ArcfjSf`@@hAVRCVrfaLk2@`+qKIZRcVh)!Z6hClSQ[(pUq
+mr*m1chCkT[1rE[pMRlrhr8[rhrAlkqGIp[UKaiHIr2IpIr6mHHpAZrrQmbqMNpl
+p4EYI6rlPc0pq%(VP&F[(LE1R6CNkrBhArQbC8EISZm9,Pbb)R$GriGcVPa0[A6V
+AjFN"6h3Fh2AP$[pjB-Mp`AH%$+fjbeT(re-DU)V$TFIGGf6$QVAV[elh4HTR+lp
+Dr[f+9D[IZRZVR`KMjGM+L-!eZmej2RlBTpr`@HJr2#TPq)-2MA51Z1IHmqm0((4
+hI%XDr25hPM6ik@mq02KdeRZ@1H0Tm!GI'R`cDPM+`m-I'[RJL(X(hc2`lN%YD$$
+*Vl$kClb)RlKf0Y'I91I[RCl)Vb9[*jmIIj%rA`(K2Mr*jeFRdGKr9EZ0#54,[r+
+[C@Tm%5$"K-UD*q'AaR)dAU0*0r'a#*L3!%bGUkJe-ET9r&aeSXaPP'3a"6$Gbda
+M+)p'8bdYSb*-rM*4!Hlf1)LlbCkQ-RU+5ZJabUC(+)XHTA4-$E23BFUP3j4$HkQ
+HGP-$lD&pp$cYTj1iZq)j&2F,Q*IlEpa(p%rFQhBR(DIEU*cqK,R%[kGMQ&L'JSU
+L(C4-#44%cE5C'UQ*0Y,VP%([8#EPidDl644"-H5Q@%UM,E5,IU3,p#CYSipS1qe
+%UIqr#(LE,Y+hG"2cfX+SVSfZd9AU4ZhT@8UN8,S1l"AbSbr4CET&jfJ!GD%R`I3
+%GD@1B(f&AUEr8!GXk8628'Ik&pe1Ik3qp(IU5hqKr[3lkNGrTFrT5qT&2e!2qT!
+!2U(rd[[d$qT*2kIHp#TeTpm`KQM-[U*hk4I8MRj0NqQA0*0q5ap!MbYBj@2mCY-
+dQN*6D6Up3Dr4RfN'IS[S1eT-5fN*,D")QNIcD5(0KHDANB*Ed2SFdhF!p1e)Jk(
+cbp$e2r3!$D(l+CMZS"!D5M9d&eQT6[Qr$`)UCPFib%8kaG&pG)3fd"TD5q[TDeT
+(Ae!UI8BVk5YD6Yr6#PT&UqNYfYS#"2jI")`(!GadTC'GE15Nma42`qK6qJEB@H4
+(2dbM+)@'di2d%)d%d`LkKqi&khXdN!!'dGhBmP)Jm"2pl59"3$"%8ph%31"6k2!
+HcF&[3K$i!hi6"i&[S1d`k2X`0"Ek2JKpl`8)h!0YliDq%`8"-YEa1e6EZ1"e#1B
+D%I+@Xm"&'*h$`JFLe'D`d%i%8a`,&d3iQ#h#Bi0&b(D+N!"Z3V#NDfa3b3,EN!!
+Hcm*N&L*CQ#[#idGBB-H2pfGK&JXM4,#8XU#`X*S&U`L(el$3KB83%A)6@)KQBBN
+)Hc0&U1mM`Zim&Xk)d'!@i83R%D5c)U61&Z%VY[QV35)X6fGK*3XA@HM&`L)4[Lp
+LJ@hq[T'&8"BqBB'*@,9BK$IEXm!5pZER)QaMUQ`VCf%l#a%LI-4)q4%MbRC'qZf
+-I0YCiVGhCU'(#1'-+1(e,,!##fH*$qr0!L0a1&-dbXA#C4&fG'@"UCA-$T,$@AL
+CKCpBB#4)CN`**KCB)K2BKL#@l#"'QU!j,$"eJaMS01mASA'q#%fR@@$EQPJ"0$(
+P0M,5EmaLJ6&YC%`EEl,!LR2MG"%bMV13!-S#8c5$J9F'BmTJK(kR@B6mSb``)-[
+hSaKSj[GNB3S,$'KDbeKJK'YPS0$+PQrGbJ)VUYDq,,$0VBb8V3aB0c%5Eh+c`&6
+Ca!LhLB(&*PDdQiD,%-'+,B+"G33VYJJ'bM%Xf6%-A')B1@)BqG`"&KKCh3bXhDb
+bZ9NPG,-%ZrZa`%MM6Q'"9GTB4Y"B#`X-8'*CBQ)C5-@b5KA,LMD@U4Ml'JYXFaS
+Vi,3'&KLjdhD`X)Z&Fbb`5T,'b*('UQAD%"'f-+@hX+4ZB8RG`JTT5cF@'1'fX'6
+[%X[`A4EKD5blQ&IB*D4UZhV*9&XS8hqBGS@b89SS&bk(F4I+mNfB$p")leXS&`G
+J+J[P-8F,j6`-PUdTP)[k&-SP(3VP3pX+jGdif0d$CN5Kh(!-"J)DZK6+HmTK`,!
+(`Tp2J!(bqGYKHX,-K*N"Ne)SlbFX'T!!jF*)@3kFNZ@50&RH(5h,crHAjIh6CIP
+%Q#bV4E+XC-LbhPQ@liZ$FF[b%C-XE`$$"QaFkiAT)F[VXf"@`Lb@jDq"r,UE,(m
+"3DPjX[cCIKJ)HqZb,)H2N!$PU(3B#)VU,XXl,XTbFUSX"jA"()%")UK0PTX9@Gi
+-38diD%9RNe@@)k"N4$2-6l)Fdai'bQlT#J2P,R5!Q5c,@HFmmZPiMr`RPdIqIEP
+(2S(1LAiHfEAG)qZA2I)UJX%"e4E,P&dXbfkBGX@bTcr-L')j8!V6$qDeBYQm&HB
+#6)pLHFcXBVPf9,&Fe!&Q5,&F8&JX(ja4,$pGAbbAK"I,f9f+j8H1`d"J9PkaR+l
+!c)3CAL`rAJ*cZ9JqI!EQ)J`fjKE"P--%&mZ(X0#K(6"Bl&"RQ0l&FNiPc'UB0TJ
+q-"#@!`AhjX*)-0L`&iGl&aI,pFYKGX&!mISj-21,jGe3D$F@DNJTP[G%&-XRNE#
+6f($bI4JXHSTJ&KA,cd'4jb$mG"N-"*q'JLqFJZPC,&Gf,jE23[&rKKE,Cm++j6Z
+Ki2%'Q%q+jG[--%MBEIYKS%5j#3BEbJFAbdHELq86dF@bj)+j#405,#Y)T()9"X4
+fl)0C"i10VJ!-L1L#F&Fmc,PL1Dke@,i[V9Jq!Z@1c#f@0r3YPYGd+jEAjX#!`'Z
+K`(S8f"G30K@&Q!VKRk8@bmXKr(XXrRel'""K"3jA`9"C3+C+3$V"p!c)JEL!2#i
+Y)*X"rHC@Q*U!2'BMc2b!R,F2*J1Q"da)3"i0aY'I"q6D!-a0Q-N"H9NYc%UBf3'
+j#-)2!(%!3N`3CKS4N!!,jJCNlfX"qH#DJ2a8DN$1kKq3!"pY#mMT8`+b"8)1lB"
+*#FJ0f3(jq9+B)3(jj0'!I!UG&`B(j%S`h@N+b#S8G4b$Q4Q3!&hVB5"!,iIT$$-
+b)-HY$U!b`Q$$NFL![!%E0[3,b'Yk"q6e5&!U%*rp"$-p)'q&iPZY!IR0&3%ji8a
+!EXk$f3l6*i!R!+!"+k`8ZV"d(4A9dlMp,Mi1FeY`m3Dc3(NY2U+SfXUYQ,4CH&4
+-aqIMa'a0V6A5&4UCGCEbFQKF'4J,[2B8ESVMDlb*+A6BR%2,LP4E+CP2+4Shm"8
+'AlVlmMa-J-iVL,mrP-+20j!!a5YGcbX$*eP-p+JLC%3bCY@@fCi1Z[KTAi`iRmQ
+"6[!QcN3MEKX9Pf0fXepQ+'41J,-*R)A(VkHRkXP8UFD[Sj`eG,K-MGp+clXT[F`
+aXA6kNp*Gf1NFAlARVXF(T8UI8D(Afk%l45ehd91BlCP0UjST0imH,4-cFmq8d"i
+6i6Sr*11bkG#q%-FdY[FM3ec'%1QSCI5lDAIaJ`l0b2ADfrRJX1jLAaBA$fQ*+[$
+G`,4YkdGe[,p@4L9HHMTEG@VPP&k#9LQP(e&Y@C6HV$V,+*hhpLGY09XfAI3-S@A
+E(F&iHK&[Sc+mmlK8*rq!LNkTcL`U`Z39cFpNZb0Bl1dNp1RL$HY%G58jP'HLFFH
+U#KiRqlaK+A4[54`l5IFj@HpY5b&,56DCLr$'9Be2&aZL8V1TV)J1QY4EH96NT5`
+629p+Hdei`@T4m,hm@rbGV3)XUU$KTZJ8H$Y%rXr,j0Z4Nj5*`2Q8#@0T85B9(1-
+hq*3*$kNZNa*@*L@X6,*CQC5L6$ViPNPKGCPF%@@br@CeN8aQ4C)YLX64XNJk#hA
+L[@'GrcFXNMB8LEQ4DV0TA#lZAKfrfm`Q80@#@KH90R`eiTeAd1rj+#S[8JFFTrV
+P9&P%KrP9bQkJJcPd1*@jSm'LRVT%0DfTU+B31%5ehF#NH0cqeY9VRcdH9H!l&)V
+e&*lT!fpEcjqT8kh3+FUFpV-8VrfCA,8LALmTQi$+f9kH-P&mQ#J6h(YF411m2S9
+9qC)Ri58*Nj`dM[hN-Nl1(U'XE#S`%HlE1e6UUUiB$,6YAYXX%[jcY2#IJQcG[2D
+jS1LNq,#j0+aN0H@9d,JLRe@D[GG6U-kCK8Y&J@2#Jd$ib)*E0B0TGle#hM)kN!!
+V0Ke!DIU#mPcKAjGJYPfU0h3Z`0RH$8qXmaIci"HjIDPGE)GHN3hE+@p0GH)MKF+
+G[D'4C-QUT`"h9XK9VdIJ-DeCZEii,@+%BLrabHBL4VLZ@ZSVb@YkUE8Ape"iZG$
+F8U4GS%"*96hYL+TX`FHI1l2TG$EYbDCFI%M+TP,F-DQ`&6"AjE*Lld[M"fdqJeD
+I`A+I`A'I39De)0eC*&&a5CAA$XALKdXh8R&f93lX4efF%'9UV%E9&*`A+#hA`L@
+Y+&ZeZ@K-YVm8FD&9*&PdD`UZ-cC[*J@b(9S&8VXM@$QrMfV09+a@+4@1@d!U"MM
+'$A5iB8B3eqmY0`hAVjIJNfbYEdfS&Hf(+(bc+XkVcXT[)5XrR*j,bdV*Qd9jafP
+C&R1lmiA5)H+eQ&$'4kSa@XBRU'1Q#85AqUXHm#CII!NkZ''S4)ShCrNHl2IA22M
+90"Uh`kH&d`C"LVhH*b8VYmECXkS45,KP3S5VSh(f'*APdU-P`VhZ+D@$Z9483JI
+09+Ek#`2N*3DZrNe$8hd!E6`1d$CY-LBGYZ$meD@IRP6kDErd-bfPRhD&@8V3M'Y
+"Q`Cr"M)TrZFT0-`ChN#9CMTC3YrLJ@aQDXLL*LmeH1R34H5#G)MhT6YVkG!15X@
+SK"TUk@3Y9GBkQ+ZBa939h8r%Ga6@l5QqSV$Zh!*E$6('f3@fSB-C-VV!&Q,jPEC
+dIp',1,'PfZhp5SbqajG`A'GbLEEe'$k,LQSCm3F*aIhql4Vmfm6)LCT`U'LV6jd
+@pDj15pp(KlcUCIL4Xh5JPNS9HUb%5RPA4N,V+,pJG1H,Ve,NVje9GAHqkQbFlp0
+QINij!V$"EAh33'dl6ERTp(3ZQ8VSDA19QRirYlJDN!$'3`lJC6EQdPUpZ#Al8[d
+&HLbRfNRLFBV9M-6FT"qJlLTa9HhVjSZ@#SrbJG,jdA`*QD[c,("qM0Re4MY4&50
+,MP,HDTmFM4eMKV@Jdl!5KBU2Jdi9f!K44mmMDcD0pdE`3,LM[UV'iZ@Pa%9jhJN
+N`T'[%F[0+j%SErQNTk%XFmfU&,QRcfNFMk[f,K0c1["bHEli21C$6P9R0+*e%cH
+"6h(&4jAbP1VFC)MIkjEaAY@iB*%Uh$qAjZ0V3QC)KGV@rG,(EK2PQfMM'8TG36q
+@8@S4rGe%UHYTVCILmNLYTD-QZY0,P59dXKle6e6+SlAL)+k@eYC5kMjkiaJ&9G,
+'@XU[*EFIDYX"Z[U+G[0LmG9Bp2S$&5akD3$jF0'l!&5Sk*d6Aj0&Vi2iP%`JiDc
+YH(mk*4bZ''9L9-j'ZPBB,hS#40m9Aj0CYhq9b%caqCR"Ejm#Cdd[RlVfreGSlIp
+(S6B),AL4c2%e[5VQ%fRjbBVQhBkEZNkVfPIG9-f,@eUmc6$fqq`YCKk"&E-K`K`
+66U08i+p26j!!aCd4LS4EXL5RD+f9q-&fV[m9`6PhE2-lI*Db(-BYm-VeNU)*@Ue
+H2hLA6S![m9j,%E[(Dk8G60@ecp#qqLUJDJFaAqBJCKBG2&H4U,B@h'USlmCc1ZS
+#kX0mE'JrDA+GmdJd+Dja,mZV@bCmRcqIQT3HYq"2cQC6YSQ+cP""#BdZ3F[0)6K
+Q-6Eal5'cDL5UGlVAQ6)f3V98(l5UQ1deiB&UXTAQXUVUaDbF,UT@L[P#id*elG3
+Z9F[+`"4r6%1FrV@fZZaVE99I9A[d+'D,TqMDCNcGbFd"%+jqLp(`i'b9dH6J*qK
+miSF9EhX",cSU*Hi6aT8F%CDRXl#5KBXXp'*KN3MI&l&`PS9'"1hl8"eJbVUBEQP
+DS@SVqU[LlP9Ye@)G0i*LX%pe[V@DikjCfeXpH*6$q9B`MbT8R&Z2F!0hdQk0&Y(
+fjPQFfGqmL1F*[0PHf2lFK8Y!N!"XIc-%r@ejBT&Yj6UZriMPYr9KBEJ)(f@,`iq
+1BE&59IXS3p81@&Al4a#KII5ZE[pS0J4q0"I25GLZD!F!%pZcGI[f5NM&I4[BZ4h
+cRA#MSRCJXQVIIJl-fcYMkrBH3)@VYTdjB(,Z61@4D)MZl)jY1fH*E6X(krE`HR#
+',pHGi3Nmh+0SiEf"R)bR*S3[iZ%""4H8a!-DSLa!49d@+#dU4,I[U)@8(4BKCBG
+,aj8QePf-pFT9Hh)C0%MHKbh*,LlZDdm1eqh*D3)E*Zc,`[iNE$6%*#m@"%J`#4%
+*Ch8Y`38aZDS@9+4V3HNUlLM5JZESpL#NhKj8!ffEXh4lmhjXE6l'Rh2BQQpL#TL
+Y1B@IF0Jflq#((3a`PXe!)q#U%0Si@GFD3E*Ph99l8aB%0*h@Y5DX8VX$ECUEJUH
+T$e#pJBS$cb$`E$6VpSeG41pfp+BM+4YVZ+9@XEhH3@ai(I*'0k#eEG+G'H%FMpc
+3-Tbk280XbEKG4l0FX,e6UY[I13VF1r"MSe(r-cIU@LB!0QqiDXqFJC0-3(8HjUA
+PSb'5Km,+2kVEmq0`NVm0[@E4Zk$EmPNkmRX#0dAJ4U&R"69D3@HYY9khYlV%F+Z
+`Q3*R"kk[k2A8F5e,N!"h%`2k6H8mh'(IP)#c6@lG[ZPPdHZ&hZHL"dAbiX3P,E&
+F4*'1#eTL9d5D!*k)cU)NR4'IX`+0Q)rM%H)J*SXGa"aR"c(EG'G-)bDI+2BB!B!
+a!+BBJ+icCUkS2(Ch!&KhZQjh!h5GlM9qE!E!fQd44eedTlZI`'VZkH"+%FKJh4j
+V"RZXKE(M[L'A29BN0MC#S12pD!&1XCm,c'Yq6$!fTjPdHeU$k"e(E`GidRD*S90
+hTXd5DQTT3h6l&U(9&QLej3L!DNZi52q@-"eAYPLhYqlF-TRMPRjYb`Jam4DZ#p$
+j)qB-MX-605iX"deYEa-,[85iZ%f%EfX&mEi9hJHIaP3Y-&pmY86RA6'[9"GICaB
+kY"ZieF1$)`kI8aJXTTVU0UdEPadf6&c'9[Xkh@E[,d6CK%#l6C5[$EA"0J3p*fV
+Yq4)H$Yh1fh9E[("bQ0USfd)V46HdbpI1aml`1T!!-rYchID)'Gj*beUMfl)kmcU
+(pQJ2A8[(cG1P'e9RlJ`q$hb(YX'j3YZF%Ph,@Bj"Ip@jem-A0LMDlU1kE6HV,,Y
+lS$Y#e,-'H+Z$CDUp`3eY'Z$A[AJ"ECL-c[ZUI8mjk,eRQl!hKHd%TMhYeR(-&M9
+PU$EC$6)jjABm#Xm*m(63EClq`'JHh#pdi(C9+`C&$JKkPHUf3$m"DB(Aq%,`QP0
+eTrN#am09R1BHr&#YSSe"VP!%ce1,ZHc,d(`TZUVDLPJe,F*%cL,N*39iF-SbT1[
+J$(63Y(JDGa[9hP5eNR!mMJV)dI!9f9d%QE1Rm%-1fb2(aH!40pm0JZAK89E3C24
+'6&i3VTDR@cLil1Nc!5hTc(FrAJ+-pMJq3q$"+XNS$NYIA6Ym"VZ@BkD#J!(Ri4R
+F+&6XZ88J3biQMqHLYSmqKPN,`8,63eYeqb%"RiFZ##ZUcU(HZLe(P+-YCl8SqT`
+f(1Ad`D)j-aPD9$rlhPbJpdT!lpdKd([Eq'D(YRHaEUYI,K$eZi6mqRkkXhi1Uk(
+eJ,Dm0-b+k#*F`@lKK(BM-mk$+fc)j2-FYSB8!+CY6`3+f,CR1&$D2P6UI8jHPk9
+Sq`IVYT0Y3[,*pcPDB5H$GGXT"TqR40DU23HAr9`mj*e@EFm*2HfRiD0XTp''FQL
+R,qVDk8'U*8qe[A"+E(U"DIG#6e8EJfbh%M9V$(c3@Fc#(30Ir%r8X$&p91e-'$V
+R91h1#qLJe)ihk,EMc,mHRk(EMip%%QicklEEQ"khLEa%+cITY[*3J5M[cK#$GHe
+2MGL2#RZd@D#1iP1UHD4U1cCF!2+*E0efiT3Sa"0GGCXN-Ma0DN4A!,a0kLb1T)'
+kTU**DZkYfT5YJN@jUYXF,1pb"9LS&fJAfLGQ3,!,MYYe6T5pD`TcL#k4GHPi")B
+C8icecp(CT6VM@RPiUH+m,if(ip%G4iT%e)kJ4-`V91H'[M`FCECKN!"Z@b-FM,B
+'lCbe)LZhV9h(JPXXZ4DY)60D5H[4CM(M(VS[,ZUf,eJl+*@e+9+KdMK8N!$2-,&
+p('VRmRCSl4aPVCpQ&YS,KrApI+(XLQaq##UXbPl(+m(H4a(IR-FTUXe)iC%1,XI
+Cj*j`)lC!R0Jk6Q300R1K!"Cc+a[8#)+1fBLDLl)E-ephjS@)KT)f1Je2K8-@'!J
+6G8ph,P[*Sq"aPXh'TlXb2JaYU!1eI#&3"fTdTfN%3aA-C5M[DlTf%#r$!8c&,i@
+(#D"QP@'UF`#IQTp#SSUGUTD0jBUhUXj(2Z!,83'c3!X2j[BrLZGeH1"adkHJdaP
+2"`)!HD$G)E5@$U&CjmN"h'F,[pL!CUIFUMVhR@85RNFE6)Cj(LkN%#lL*0a))5$
+eP%"Jd[J,!+R+Qq,Y5,AGD4)5lZb!er9ieARE2TBKhZEfamQXfT8MIcGb!Ah[SRl
+DITmKr1maZ!!$jA@L4K(IlG3i!"KZ#Ii*cbI!cF&KUXea6&4&ad`4A1Y&GZ'DSY[
+dND)EYeUh(@(Zq%JNJ)+eDpIR#X4kY$'qaJfdMDTYAED!QR@iKASP`1)8E[99YG3
+i"kji&MDlqpEd`qrbM"R5bJUcI-D-'aeVDQS'@81XeS&1je5VGBL`k,mKqX(cB1m
+GH+-96$9@Dc"$$Vpa2Y4U23G%I,!e'-L3!2R@mAmK0Cp1F2b0rk5'R8D'##',3PJ
+-XBDdBlfPeBK[&YI82&$$9"J#&$5lIkl6'H*d$UcJ'$LPj4JElUi4SZqTUER(EVF
+2U9NSJN!Ym2FBilf,lHa[F-hp6Q[0%2m5JiC#`R"RF!A6hGpZG%,!h68MX(e`63A
+krT(1i*U"6UZ6#AhB+@J98M-Yl*c914F5RIB4M#ah["CkHEJB9b&5r([mDLjJqrc
+,I#Hf$445S2c$!Rd2&!6LrZr%k#&d(kMHZ9$d[UNBcUhS$(TB-%9@,9G"V-&h,,&
+H@(l68988+2Ad(ZGlK6hCmBj18Z-!kB+`jk6AAVlRKd[aPbl&5hVmTHjhX,rh`m,
+#"Jbp(*Ei4qQG+lIIdr(k`%'IXb#j1mk4GSlXH-r)BF1NV5`NRqrD*5bXmp$Jb`1
+ZA4rBi9EEe@khHRHpF[f6X$#THFS28kC)b6#K$dp"q"f#G#(-kV`Ul84i-K42LYh
+fGX4GrdIr[EeAJ(00-!2hhrkjJYbIh[$@#1b096Hk*refb'[a(`b+[p%TrMf%UcH
+IX(jX[A(9DEha`lHR4PVRhPJ&i,MaSG0kmchl,2YNqc`VLMM*DPeJYFkarYVqkH@
+8Fdk8Aejjl%0A*18"bGAc`b&h$lPEq[!h&Cfr*clc5[#JrSPAm9-p9kj,NhX1NP+
+P'T62@P&)IadL25X&59ZlR*HZL6,i9PLEAGTLIpC1rVrE*+i@U6Q%fEcaSD(2KSC
+fHq,FbqKfAIRA!BRA*BH`kd+Pe&"rq$#d9fM2a1Z[![e@k#H*Rb4+6h`TVIK"$8M
+6T#6)'bGPfX+)e00Y9pU%I!!!("&"4%05!`!Zm3p9$@9&%3!aCHj$[fe[PMPI`XX
+-qBD3!*1mK$R(6,,KN64(*5jC%ZFbNV&%#GambG4N%mQ50FBdjAT`-6'%D#''&Lb
+A3`1PTr(j$#a3Uak"!CE$&5mhmRbXpAJj)K5NL1@fA+rBe(hqIZqlC!Q@FZrTIIi
+"'kBRj8%3"%!3!+)"&qIa%Cd1,cjFb&a3L@5%!ElqCp-,,Fl'lKBqfHd02Nk9r(U
+Ur'*miC%lRHrprB[e%)P$@TXDHABkE&PSF[T8dqPb*"di"TiicB48I+iIR@HMMh(
+aBjKB93M2%[YD&%+(lQ-&cHLm3r[`85eq*-32[km0lM(4c5-jJ)*qFMJjq%jA&cF
+F*4FN+bM0S%T)T*`ih1X`$PPq&DjiQEGH1a,kli*3!6QT4Qrji*ReU9CZH5F3@VX
+h4+j$hAGlHadCeir[$E6j9MU9MAYU,I1j[r[(p,Ia3[H2cqrRfrZFIhCSJe2pj*i
+V)F02!p'F3&2CP"9r999Naq@Ah,dH02HMCYQ"ld&@X1(!hGA1#ZZSdDT`1BYHNk'
+`AfQ53F&N'9kYm@UmBN9q[$il%-VP[G[MJLRS1D-%KpVdLHe@LPeKE42$`ib--J*
+(r3iiE+'5p6[#0Y9I[f1)UkEMHhba3%cGd+5%fheQ8hlFfrL4(1%*6d)@q'FHS5N
+5eE#+@&Njr`a&SHcGTNM[AXpUGB15TLBDXSS9'0I'G'MZjK%K*C8*VIbcNE"&65"
+TCG8'NEb,U5E$9M+A"#16QQ!J&8iG*-cmfKZMR0pYHJ-L"DEbZP8CRcIkc1%HH1Z
+$b3TU1!DR[&bVQq@!-LFJEV9i0A&jqCGpX8PTq2piiC5HGF@6A6KRpCAlVZ5@V5k
+!QebS$qrS(jX98XIEiZf'j!kkeh+emeNI1X,bH#STp$RrT29DT'8prCjT60m+jrF
+#E28jY3eTV"iNX6VVAr#Ce3hU&C2GNr$fKXhDa1R0A%$45`P)keBH'p&FGNc,DMX
+5I4TVhH@pe8U8LPrfb8MFYDYl8a&pm-&Pa*`c")Sm0%NmJUmLkN@b,baH'Ui%2Vr
+idNKa@RfT2MQ8h`BRU!TQ`X4E-P2"V,ElV-KU@Sq9Rl&5UM+TT-k@S6&!F'5N4jd
+pmNd1(&G)M5'efZZ)Md8pTS)$5`1K03@pHeIpHVK#66d[Kaa%d$Q(4e!VSKBeGA9
+*eD3`8K%9`KA@lGm@&&f+"M$B9ccih)VR&6DSl0b+Uj95LpGSGHEr9GEUA@p#rhV
+a-@a2aFDIHYYm9QqRlr"p&e46rF1cmT'LU8K'Y*'@N@3&%JJCA%Bae$+#9-!AUEB
+AB6BDS36e!B8fSZ6LD!*@d-9c1DkYd,8$hi3V!$aK*$8F8i1"0QmTp'8T!P2pFip
+m#$)5K#5qYN)j%(RJed-9UYp-L@S1F5A4`")U%-N6j+D68Q"UCI0H8N69IepQFjS
+"190YRQU[96AEEdIH1r,8X-qN,SLhKR[$HbqhFk46eIA9JJ48Uq-b+94RD85DCSN
+"+GP!b!1Lh[Df5HN)3m93fk`X6ibj-(M86am#$k!MP")1KR6$"*HlZ*K5S(6%LVe
+'B4c*"*C!%)K43',m1`0MAp[bI$,)5#B8'X"%R3Q"+Bpheb'Cji54'$$aR[jiNlU
+rerbF&JQQmQHG)jNQQmFI"R$bJQefhL3Dr"`ZP'CLqKVTr8C+69S+)rIfeCN`C#I
+E6(Hr%Y([*X4"#3a*a*Y-!%VFN!"'3BS&`rrD9qIZ,akL+pr4$h%&L6fH`%meA8S
+e1KYKp'd`#NJNaZ&qKR(C4Y9IJ4cHr4)Qi&hD5GTF$2Gb*$YjX2[(!-C@E'6VMRj
+D6!H-C11@1KbY"DZbiL08V8QeJI98DR$,EeBBYaBLV65iT@k&FF[&P5jFTmI@q%%
+D$[EKB2+imi-d1QK`EUPT3)Hpd,EP&AA`Jl66U0!'La&%QC!!%'6i(&+$1hdchTY
+j+'`'ZQZf,H%@*+3#[#mD#eYK1)j4@UJfTSr`,!eSlYp!S0TB(dB5Uhk5&-jRR9M
+)KF@p*aCbrk0JQ4TXZ@4al4pXZG(bbG11P'"a2Hd`(jR[KcViYBNcMV("PMf@reJ
+rf0*XHDIZME%+bhr8[6%FA2X%r4eliXk#9@q-CkAmc9fUp5Z%Bq#e!8`VQcYBKCq
+4-E[(V&S""Xh'qX%CPYiZVcG4ZJLT,HHI&!JqJeYliek[PG+kf&3j1HMDe6E%%qH
+(f$CA8`)4JQ(jeNje*ZVeDF5&%9USfT%C5i"pUD8Ere@Gm9R)E*4@1j24f4TA8i2
+19QaECVbaflQaq43U0eirHX['pqVr2hY9Li"F5mQl%e+J!d1eT(#qSXpjfhb6MA9
+RY5@9brqia-5CNBjK35E3Y`H)V)QEmi+Rl"[A,1cDH1a8"bBjTPZld,+aQDE4cRN
+U#P8++)-Ecq3UVJ)),A$ELZaUUl$c@qh4EIUT2phEP#4J3(`EMZMZeVBMh&34*lF
+B9H69mS&q$'kSLTC8l)DLQ!Dhh)C!QVP@S$'B0&X+jbJBi*!!M6biYG$GRfj*i5J
+C`q%Rf#4b&!rV2LQFAQ`E%e+95*ec$4aYAb,Kq5pG''jmraPLdqIFjkBKKJ)ZSA5
+IT5*0M24i&dMT4[2L5AC"@ETJP!Ih5mXJ,T``mDPqN!!@`(88Neqk8[GC1!%h64N
+Z!aE"CQDDDQN$UIV8I0jGHK1Mdh4)DJk!V$KP+hhFdfmJ9")5,B8k(3Q+3LH@[aH
+f*"-Y*a%B8%$EJ+[-3T*I4NAq4qJSYY`@cB%4fDr6NE1$',4%NHiN4c`D,c-1cie
+H*0C9`@+cZ,$&+@TfP3q2Fc*8%V"jL0,"Ihb'JD%kANfX#45Rl-l@D"0$5RZ9km#
+e$j!!D!!5FR1qc3cjmPe[6rAV*@%Z8TG,M[*'G,N'`q'G8IGldM-QBEi[LZBEJ85
+ZVh8A$H%G66``"025JFicf`66%PrD&NNZB'6#a)$iLrVE"A3dQB6i'%#!iq6qbD+
+60l2Y1iLIA9VHmJ)-UNSX31JZZ'-2JX@h99K)CUZ1Q5d4T3pQNFRVrPTA0hVXB"D
+%[F82iLUkTlZcG8p"FE+HUN3cM%JH3qM"Tq,eBRTQ-3bck2Fd03CdIi3`()[lmE*
+iT!5UBFScqSB54KCSVpp-%,k!QVaFUP%"8&UdXLJdFrr+K"Yd0Cpk6Ek1J5[,IM8
+C9M3@4f1C*ImKfd6%e*9G4S*R#J"HJC!!LdNr,5SkmrU&Remk%+#P6BFYDBYYia"
+)MDfQ,Sq5@LJYl89A1GZ9lDHP5cFYqh!bjL[c2Zl,MclkmdXHBD!QfZ26K&'KGJj
+NMR3mrUNkCj9ME5Ep,FTXIZeZKpTjr0*)E&A"fYISEp&Vef6HAI#P)d2"YP#UDbc
+F19$MlSp@*bXX0k2VAUiE#Lb!XklMq#@Ym![A8Uj,k3YE+4)ZFGeHQc(@[EKlFDm
+YSm5NRYmIimP"jhS`fG5hI%k1(SJS%1"1U'IS&lGX2ZLKcBG+3,K'PGAT4!H[+10
+F-N9m&`NZmj!!H"@hf3mK"d,6#4kbmdU%4RebIVp#%jd!dfaadR%8PRBERH&ZTc0
+JkQ)SeUI9[$2AadG[F9kG6-9!AR"8'MDR9DUF%+J54*b`c,H"a$NK1TK)6FJiM*d
+A*-Da4@!h(4d`GF6$a8cmbfRJ#(lXppSiL@-frY3`'T@UhU+(5NrJcb,#Y)PQqhQ
+4D(r192p#J01T!U85HNEpGZUiD5Je[U%#ql`Sj(%Bj5CR1-1@`P@CBrBY38TZUEY
+D(!$*3TXci-BJLB(4&4Kd"UJ*rER15`Pr!5R6GA*Sc#p[i(*f,DSU*YE*20@ZBL'
+3!+HH'2`l'%4ITDTF@DS5M&afKQRjZK`CB[epQ@'MFrJk9h3)CJA6aNN`%4!S%d$
+@cA9I*SJE2Ze#da*-9MQ)45m4CGATiMG1D15Z)*mF9L2@I#cdIC-@ih)qf[JkSbB
+CJH%GH-6T9!IkM6cdAKiRF-!Cp@F*C8+E[GQkI@!`0TNi)IJlG"%SB[hh#PM%f$0
+Y!&P%ad#3!#J"33*J'FBLQdH@#"hSMr*3Uf(!)@R!jb8$2RH'r4emp(Y&hK"0P-@
+fNJ)Y"!`EIjj2Tq63JaYd"dXfe$q4`SCZd0r3hp''AVh5$I9M)mIAjf*6jrcR0K@
+L5&HmF%cSh3"bbSm%eeIHPIfpZRTUJcGQ[qApTe*IeA#,LiLlBL-bjT9F,q@hJZ%
+`Aj'IVUL9$IN@&b9hGEV&MQK#1[4'&MY5&4EA#$ZSF``&Ca9N#0ZbM'1UB#A4h$F
+#K"ba(&i4idd'K&4+)H3`e$+0(B3+H@q(jj-S,hm9320Gpki2Vhr-6A9XbLcl,ac
+Y`T&0A`3p"4(LrIVeJqrAbk193XCdDP50%8#lYG8#IN*IRG2TUVPeP)k0Ur6G406
+Fe6*MR+31U4VTc9H2m%+HaeqQ!+KUkG"RJf%hRdQEeLL9Xed8j2@P)plD@'R*RiM
+)A6UG4bK%X&R+VP8E-JZ$pf`ffG0EdC9$*%RkBC!!`J2pB#rMFaBCVS%D#Q0"Nr+
+#FA-T*j)I$MadLMQIcbdB[H9p9aRLkfDr2HmelHHZ!J@'GlCV+(6[+fFFqP8"rlf
+rAP1U+PaaEmheT4H&2[iL*G98XN!0"GS-,MEG,S!VC3Kd3UT,jNTfi18J!R#8Zia
+jR,UDjJYHIMr#6Q4qapIm'h0S8iGX9lJ4,PTqSlU!QYHIkh`F6[KGhJ93PFhDfj[
+KTRc3aJ*Y)[*khLD(iV9-j0[PXpeaMLV'XDP@ir[epqHIip'%G$LqAUD2FL3`bY'
+eHD"3DA&IbKk)S4XC([[U&5%1J6UUT-6"K!TI1Di@aRPd+'8IBXXHr-NV)Ge"%ej
+34!K89CGRKmEjUL[&dhJHC3HihMM%(AQIIV1`N!!$6@[c'+T!&@`q'm6[0+LA![A
+F,kTRq3p8ch+%$MP,9"1$MA0*$5A!$A-XAhm#aJGG61T)k+TG#U'83%')E6+p+T!
+!L*bA1KAbprd6IJi%dI*@a$G0mRTV&i(lMM5CQ[2Ap1SAjl)#P)89YiQ'5Nj&V(C
++%0f49XX0bdZE+5c2I,Rb%TEhl+@M"pM4LibXhJjX8TNq%kR5XkKNDY2,jfP`EQ*
+0!3eIa)Er[imlA&BUV"c(N6XFYC`5&8hVcGb5CVA6%LJC2jLAahdQVab0IGr13`-
+Aa+-didh*a(P5I5D)r[-B08a++55D`hRXb[GPGYcbI[0eV[-4"8EEiS$BSC%%Y2)
+(h$9@ZfcRPdQeLql8Gm+)!CR9ASBHB61))p&@[KpNP(fAiM!%GZCD5M-ZBXNL!bQ
+6)LNX[$)THp2K8%dL+3@RR*V1j4'cU5$ZekcZ,I$X8Xe`bHh1QTNjN!#Zr5hf25Q
+-B$Q5-GHU)4D5kSLRY$EApRLVp[aF"e$Y@QrSRLZCl$-Xh&16jSJ+KU14d$f[EAH
+%Jc5*ZPfGl@hVfre)4q(i41I-KU+FISrRC&(1c%blqi"l4`C,6*BE6#J%@EQl!BN
+5Z%[*fGja'qGP19!$e@H&!im(bjCp@)4(6061dqmZqh3T$`UQV9a'fM+QQSprk)h
+j!Paqi),k@60FaclE%4k)l0LV4RBiLYEjr*[fVVS`(&%VlmZFp9f-&l@Uf!i`FRN
+YXeTiE&,`QD2+8-5D&48#F-qIfhYJcb-IBP+rD3XA2!*3mdR9H[S'*%EN&r$!aZ,
+(eB882%Z`J9ZH42e-U1*Rc9K1ee!GC1"m[6dAU!MhP`$Rpc,1QrBJ4KrGJTZj@#$
+`LjANJR2haa[Ai'0jfY*UK0QehY-*F,CQfD,A)hh@b&*X$XEFIGSP%J)dd#VAZA"
+a`F-2RM'JR5-P`E[pZHc*MX)$4GSFC)+Y5![R6NU3!2rUrXGH,$QCRHe**c6&KXA
+#mlRm,4*1(NR3ee!J-B981l`55r[Zh0bLl*c4!c55Q0Qr@LH9CZF8j4l05Fme"(i
+VNTPI3S'mFARmX13BGA!N!TG`a8FJ58K!ZAEF"#HL*iC(@A3!p2@di,+E+l5jmIG
+30BXCGS,eBCLM*jYYU90F-NL,BC*5H%e!fVG`0aq!aCN2AA1MN[i+-H0LRSA%!TK
+&XlA9l--M9PbYeE#2RH*(RlLJAD`BdcDbMh&a`,#i`#Gq6%r4U`RNS@RiYmaFZEQ
+!(IMC94+iL*a5#)3`pDaKk`K,B1`V+Y5$i99"L+d38NNHFj9,&rfcBZ&pZr&bd'X
+f+maQ"4-VQ&LKNa8k8IL$0-pMkAP&2HRYlN+fkbF0@b1PL`K"N4LDcbI8hR%&bD'
+R`qBrh-STR$@#0M(!(9NEpdiJX$l2lpZ`i9EH&'!#V@Y[h2pkc9NV9eqrd'YICBE
+4#Q8mS'ecCFA$H8TK*9YFbaC(X&Ki[FCAKk9GUcVK#)pNc&0C)R!rM`FQpUXmVl+
+%VI*QcHXe%(@B8Y5DT[T&pN,'RHU'PhT!U0QG1E)"D,pIcH"##E*rAlUY1ehEQh2
+d`-hYZ8H043bZkh[QjkErb*kHR30iV`cR'CVkdS'1556iJ+$)"h#C+E9RCbLI%TV
+DbQf1l)3Dq4Xc&Y&U0I+Q3bU-cZ0Uf)*YDV+iGMML'[bd`Ua(,!k,LfhilK5F"@T
+-+UJDk50m-jqilYf5B3Tq'XRC8$,)@R@)Bk6%GZimQV&l*AI,B&Z,4d(%8%`SRZ`
+PaC-p2S15e6lPKH--`U1SF16qmkbKiX224kmC,aZ,5!V+G3C&Lf`Z9V4)245Y$kp
+AZ#YB&V`a&!Zp'VS8fKGm+&,2rXBLCV`bI6+jhP6l#+k*K`Y#PTr%1"kVmIFe5#U
+%jML2[%V,B02YF$Vk*I,qj8Z6P%CVA5Q$4&r$9,qSG$c5+Nd$*J*M%M)`)4C*VYU
+V6KQD0i5N)Ca4%hqCad-"6$X)TVTb(jc6q+a'Bpk,`'L%2*!!q%6-K'[qiM,PTfY
+q2jHQ`Z-`(Ad0[IP6rGR(402!3lmCNKN*lISNH'dPP59Amr'5bS5K-P"F@9dbQ+[
+#5+4iHPc(qjBND(abGrbUB!$iE!!H"9FQp$DJfJ#1i*SI"X!I1,5HE9eST9Xhp"E
+%91ZaP$C6[%5`MlD'EFFL'PjUX1dd`YDm&V9Gh,*UhHhBXQTmDR3hBF[S!B5EU$P
+D#QL*P3*0-Z5FhqQ62alLN!$6J+r33p9%P3Z2r#"'!`D8RErX'*+pH@,a94@)H(S
+4$d&FLDPG*JJIm4(9lR8[Za8ZdGMCq8L*3434Vd$-BJ3beY9--eC$-*K$T6XF5C&
+6P@)AbmY$hHc#rpa9e8cZb2i4K!*Q+6q1NA6RFB1)TM!4MES0*)aK%-1GF%+S6)b
+"f#@CPSF2LXjN5K)U%%ccTFjaQm1iUGLpkdK+a-`q16Zl9eYdi$R2F`H1'RT$##I
+M4B8c*r82*#,fd+1aj1U%m&!ff#qTkX2ef+MYc+'pL#T'9TXF%+4%ec&9RGe2*-&
+T$VQfV%G[NDhM'-,R@AGMrAB8SZCK@cM6Dm,@9q0DHqMJK5N8$p,30fp+bSc&F$&
+6#K*Ra5qP$6!mKRYPCQChGP%KVT!!8c6*THkFa'Rc2,k2bqCjL$(hpTdf'(CcHRE
+FY0ZSAFPqj*8)8mb`qm33Hb6K)K,564pK(FSL'2dYh(,jCYl&"Ec-2)D(3FZJIN!
+IG3K0$5LI0#6F"0,,5VEL-BN)bp(XbBbL(598IbcFq'%EYCSD,#6m0IdE*R3FCS&
+-B3I!G3DSBK1lS+peCb$dLDJ,8Dm,MQDN&h4R$)p+dKmU&VNchCN`!e[j"$ek5J0
+DhaY(#Ne2++apd@Eda4X&'dmBTe'3!100[ECi'$qKD2AKZ65pf08T"LBIaBK*G$N
+5R[Ym2Ip!a`$!#EcVFLqh3(R-PcZj1bVJdef9U-%PI!)+mF1)b3!"HA%2)bBEKDP
+i!S4-iXI+e'8e6FR-4S"hk5Z0aaSGNbimN!$TXb39``)*A6dMbF--K!aK`cddT-V
+P0&8Zah9,b!fEP)X(6Kq"3$laMd8miG[+,@HA%-,J"B5"X0SP+cc!5'P91`RXCp(
+!`)'&(LM3VFCMc44mJ`SBjY9d+%f2#pd0*20EY%!bLE`QGlqKf@N3H4Nb5AL@HeA
+di[bCFYjMq6ZH91'@[q[S%F%[!-j*[MqCcRZi$Dm"hSAA&,IJ&HAQj1Fde@AKMCQ
+C(1)NU8Sb3BM(M+F'T$,6+6@N(aIE,dGc$X`Rp1eLJMB'3$'"IMaHKPH-dRe-TCm
+Ik-IQFi3KP5%prq+`VDmCDPf8$G8i3$biBF*NK"kfpi6b"$JKPd'!r"5ZepK![kI
+94+!i!MF02VbIS$R`@kVSDiKZ8Nf'j[eV-c2C2`)ma)E`2"DB)6AIL9QcD)cQ&4X
+MFGKN"N&40"$5!*!!IBb1DiMT8C%VBfYBi"eE1F-DBRK8j%K$lUC8P!RUUpR(c'5
+j[TR8p)8cI3BcHAGT-pQENJbYCP1aQ3c25+'![aHhDQETdFQCSaNCk3GQC[l[C-j
+NZhJ0GZ9CY26iC-jm!kU8AN+),LhC[G)PUR'2YDq",8&Mb[KFpY'FSUXXf5NYUGZ
+YCqm-DcKc@MKEY#m"-EL!Pm"M#bdY@M,LIEXAcmcN&X@I1`RZ-r'-p+9(-fE5Pbi
+"%bkP(G'3!+L&Qd80*(PBlHKZ3(LE6#PGPV$E(EE,CGcY@@qp)"rQGNq)IH`82r)
+m6DUp58(3S"[T8835&3m%'cbZ4Bd%jTKl+BjrH)(3-A*+Y2ab36`QTQTh+jS9(hR
+@bDhm*FrYH6cDT%Cb%j*`T'Qe&&MHZFDKEEl'i3[LkE+A2+[8$MAI-!8EY%YkQ65
+H%TBqXr9#Y-9D)j+F`&!L("@0&04S,el+VT*!j8jT!CEZ,$jQbpdXl@[e0'il(0m
+F98b4iLY+,((`9m13!$mBd)ATf``&Y"r0,4)4(ZLTh8QKXJMV3L!'K6+'jJld)h"
+fc"$qC8!l0Q$313DRHBYqN!#P@,QebU*[Ue4m@UALNU'#a!Xp4QqA",%iR@-Xq%6
+"Mia3`C*&3HTk0G'53aD5@-aL&ahVTlIaX&r%9C!!1qHZ%X+e%EMejC`jGfpmfm'
+@&"5l'-R`@CC3Z[Lk%hG3`&bS'ih4JIl5!ErId&'`9,#VP`HVKVZb"L3%$B6@P-'
+e&-DrEP&p(8"P[lI$LiTCq3G#hJMqT3A#,T*)!22h@UN,8q)#a!i9J6f4rCb&L,4
+lj)I5rM(hXTf(dD'UU)bK8M$PCjp,qDX%ETD)PjK@!k2DD+)3bA$Bh2&A&+cCj5B
+Vh2%DK%1DTc,Y0fJ2Uhpjme-diXa6&lCYiH%$JQmK$bH*V!8X44*SjDBd4TE'91&
+*31a@4lSS&2!XrP@'f[PNUB"&3mJ!%B#`!D@3!$GU6!%HM#m&bJEM8bL%iUe!f8D
+!0C5NU4EL-BlP0`cFBH-4Gcm@4$b%hL&2#X'hL3#1"frQB9k'CUHDV%#S3TNP"af
+N,'h5$8qL1`dA"SP!45J91TQ3!))Kb@@)KFH!CJJ+1"MUAX)EfDH'[ET9%`Pbd[E
+#+(aMhYVKHk*Z021G3hA[P)m@2V([GlE4QVURF4CcIh$)mmlS[Z2GfirE2N60a'-
+IAE69M#CX,9QMYcjI1rVNRqlpF0@IrhEAQBXA,ajkrml4ZjFpHZbl6FmmRVrmpcD
+lEH1KZMffU`mYYc8FUV0e003mrGd[0lFmGEcKMCpHf3S!!%GU384$8J-!HZ!393e
+N9J%3-6AZ4IqrEFia9aNbl'+XrM+@C4'IGk'*YF6JQ#,,X'UQTBCbB+@`@D+b3ca
+H$ap[ZS%mEi$Q8-**kEQjr4+DNkT8*Fpl+&p,FJc3K&)1ek3d!8S6bL%TTB4b#5@
+'LR[rrRkr2Dq'p2Cl2mrrpr-!'kfR+#H#)!L!3$62PiT(G6Uma18Y6JE3(lq!c&@
+ba"F4B%P@2Ke-'%BJ+T@Naj+5rlqMq&3P29#fDHEeQ3qPY0,qNRh55@Qrc1a4'&P
+k8a@8-AA-X$QiA9If354Kq(VkdANK5G-9XdTDU'Md'Ej!($mK+$0--bq!"5D$`f*
+@"V6J!K$+pCcj5a4@CSpd5*k-NmKiMTU'!T'F1U('SXbL9kmqH8+%6'HKY1Q9LN9
+FXJImN@)J#G8)d!NfIkG)lKLEbX1N6#-L[$VQ6q`h*Rir2@!eq3-1$'LAVSM3r')
+4ZKj+l!mfhe'N24RX@1!Vh),'-41'$GLI56GF&I(XbQIR59dZ,'&CVbcVX9a%bhS
+A,SC)b$@%TRT9"I1bAS3`B82Y#GhLCp)G(5mA-8QIhC(U!P29irUakmG+FfP3aeP
+LG'4fThcBS03952*aB0QFXMAaJI24e,RfUr&&d#'eqj!!8+ecKIU6b53cTfdX0+P
+HD'SVAGV#5TI*$&(Q6@E!B[#TN5jmI[)%@-Q9Kl#TAJ5Q,9F-PGP5%Q!aj%aD3e&
+%Z#SVXihe)ae-F#A41Pe$0Y)iVqK1QThSdQZSM`0*,29Kd&iDY0Pb8*Q9+GUDaR0
+$)MRi(e,A%qE+$&SFQV#S0H8'J*,!K[1$P@!"MNfH$'aU'1+*#C&U[iZh@&Yj#+,
+,@4-Z%0!he9EbYRT+d[P#@-`1(*J!HVhrpm("BVXj1#JE'Ie06+L5G%c2Gq%Lc1"
+e"J(`'SR0UFE"jM3,FDUS4eKZKCQr#&jkA"$&($1,lFaqE6qJeE`8LQGr$@aX%ri
+l4)Y))*mb+PbQZKqBBSq1#+-'dIfa1N46L!l%*%4E%IeLV!h4)85cBhC%NiLQad)
+M3*!!PKGcJiS$5!)-MUdJP#P30f*0&9DD%[["J1X$DV0+3r0I[4j+Q3jYmbb3!"G
+M@jNPRrTIK#D5lS&D@@e)L"qU[fBDG$B0HQ2%#[+EP#'Mrf1Em-FF19G&Fd`rVeJ
+NBrk8b@Lh11!"U5%3Gar51S'Kc9PpZI%4#"(#MpH3!%Kq$aPrX*EfCql0h!ZKTdd
+c,VC,kjqEUL[6V!pI%@e!hIkaFD(ld-a4V5qarcY&KlCKSR`T[DY&1Ab4*HS,ETe
+m0*,*ELT@pB'fTMT9hh4&I6qlm[P`5Q5Q"ra2pUPk0$C6Br1,'T[41%503bpU(*,
+UC""a#$X"5U`P9DHH#PLE2-l*%APbMhV+I89G'LB3-dVSJ9,5%'P'83d9j1VF0S%
+#FLJ@0k%KN!"%iCeQ+$,'TA'G,[pjT`)#3-M&1l1kX6P$JFML5(p%Q*&i-fb6r+c
+b"3[1ENa+,fXrFMNb6TY13pMd4&I1mF@f4N+lFL9r4Li#9V2dFXP(VT[bCfajd$2
+0*i8`RCUiUr`C@ajaUN$5,%N,`(%BkMfI%X2YV2f+k"+Kc(3`elpM&*k,M!)j)$k
+@"dji*lm%&"i1)2c(S1Srq%X4kY['#*DAY,iCMFNVSPdN!NP4$)k+810YUqdH)38
+FH$d&9@pq[XH1p31GQ'#f6AJU%-IVi4Kh!dbTm5#,#+Y6+VEDN[5)pTL9PUi)P4E
+M[%L(5$b)#q6QT!"LP3chSF$)#CpPiXqr6d4CB*%(pNfF1X`XY2"jCH+`Hk)C%c9
+A4)*9-UYdM"T@RT@E*$3j9Pmb3dACaJ[#4`Y',-5$CQqa'NqZaXAL`54rJ#5U2$N
+Sf4ENb3kDc+45mHRRcbI[%aG929jMDM0H0p3K[!E80V`be4Bi9X69GL$EIm6#8I8
+8AL9U0Pj'9I[BIC!!DmlKeD11ia96Mq*eA6AMC9,(-+PA(F8VT6EL9DGHa'!G+U[
+1HbMCVPi+JqPFV,VSmck$f@@fI9D$lHcm+,4&'hpRm&j9$I64a&'M%+9d-6l)43I
+eUKIP#bM(M8&%5"R-KU,(c(6"L'V'8Tfbj-*5MGUcQlI5#q*VS%I8l6DVKc&89XK
+S+JiC!fCm(!pGjmf&#KbV3d+hDVFj9%d(Y!GDL24*$&%B+M6'GqH*8+J3R`@Kqi,
+"r0`RcD&KQ@K!#0N"Jied-I88*i`mR(T1'Dj954`Hm$le,r+!kPr`q5[e'4i`[cK
+dr8QcH[c*(XmP$$2X'F%VkUPR9D!083`UB[P3RS#bqNqZ+YhdaPSZUZA!9SCXU'K
+a19j"306GHh#&E[2-m"JMR,M'Ba6*9Y1CQ&8Ze[pFh-K&HMbi%!eqL-*PZK`%@rf
+'+Y%-XISGkVaQ6-4%HaA%kQd!mehbX,@(G5ZBZ4NAZZ@[X"Tl#B[KZ-V'#-4[b3r
+KIIRmNlIdNZGQ,X5RjANU$rC*#)HXd-f"Xm1+b2kAYiUSY2rJGK'Y5rlM[P6(4K5
+Gq'R'%-YRRcb-$TRl-[H0V4iZ-rAK#MAS0NIDElrjhrJAL)m!ME5(69G%4b!j0Ti
+2YjKf2B'1(k+V&6m1r0Ma`mh2'd9m+iVQYS!,#,)0`96$`G3kMcq"2+TdLjS%JVJ
+'S[`9%Eq8RqpY%N%0-QKkr$4$F8#)f,S,`6RkbRh)bXpch8G)3E)09XfIra1$c8D
+cK!cX2"k8V[PRA,0AlJBfbU,K1$N)r-Nk5rJ")Ke!P[H*T"V(+`k8LCF)!H$d&*L
+Ee4DmKLLSYe&3Ed&3(pDp3i$8+Ic13NN@@m$bR4SBV`9`k9i,kZE2%Y'BhSNNM@&
+dI)f3!%'+N!""(B&dShSZmmMa)m(QMElC2Z090%5T18A0+1"fFf!V`DY@I@BhGF#
+V5Ih,hkkU*EVA!f%jXB20qAXPFpmfeBMNDY5p2U14*Vb*ccUej&*c[RGp%6@pQHp
+0QA(B2K1!2*Bba@04$4bq$%AcF`[$R+%Qm!`aH(C![3Q3!),+831h"hED@Ci2"Xe
+d%i*'5AUJQCHPT$3!"Xld'BhmQ6+XRlTaRc*i&)0h"[hcI!FQ$HbIja`B!GK$L(*
+28)hDjd"dhReFP5JE,1eq2kRL-dUI8Iid1U5"V#12C@++()Q@((XQ9qUi#3"!m%k
+BVUV4!&M9QMT9bLp@%eL-[)*&hAaDM1*$dP8KNiN*GrT5"cGkdG#SQiqP4Ph9REl
+elmlHKdQGZN(Ud)NJ9KcYZ&DPHbGem%hI,3DQ45KNPraqKDkifS!X)i%HT[KSS-'
+E6&TXIrdAT)B(-4#433)C@Nfj`j1)i(R0533'N!!L!!K23&"IlKKkZ3J"V#f$(Dp
+QdfXE[d)hM#+dGk)3j"#a*$VK@U&KCj((5@V2"G%Z(QLCG+MCH5K)DEpCT9[a)h3
+'mPLN@kiNJ&dDk0ZUddRq'BdC4e)$*UX6$AMmf-l8@!X9Le$C"KabiA,T)VR2,$I
+'J`Q1-*UC4m%-U'Z4-6kb(THE1JTa!d%la-8pf"1,1'JlVXh$*aINcQ!DQPQ["Y0
+N`3&L3eMC,)VdJ1)8!V%S9#pfpkJeb)6[MCVkIUSfXX-1rkH!B+A&Smj&ZV43YEC
+V#l8AJ5X4-Z)9SH+T*P6!`5TdPB09k$iZe%,9H$dF+JcAKDkLLa9Ldm@qED&,,"E
+2D%4'1r4#b5#f-rN*k&ZCq%%r%m@G"1SlR!4'268XiNB3I*[RE*!!"KE&,cM`64T
+BXJdX64SiTJ`X64TB`X$D&`dETf&[d+$0YN'E*`dkT!cDr1*"#HQ(J3J@"9L`EU0
+%Y@IR0,qMX-C+(i4l&*&rM-5"+0!$b1DjP,qA#hFUePZPZY#`XfJf0PY18Bmc1SQ
+`JbT!1PB!6DXDX`+9pC,M$BSIrRLjL)%#52Ic&S&LE$SAfBDVDK`Lir4q),@Q"N3
+rKk$IaTPU"VS9ThJSA,)YCXeTe(dHD0k0+@S[&qd1L-iFF)6Z9T`8R$S`L+G$A'l
+Ri,#l"pPH()#-Fk0Z1SDb`fd0'HGBXUNp1qIqY**dZ3KALZeKABi5p(Sd(J[@hfC
+Q1R!fGU)B!@B$&I%JeR$J(!X%NZRJpY!PS0X9M-*$KB&Q"5N-I4dC"@-ESiUJJ%K
+e&8R%$L2,q8-qhNPB"2(Pc'5a*HTj%2jiS-4jJ'Td(U$qjB818%[F"kJPcJ28id#
+`fXN(6#""Mb8"R+`*RBZ&,$#kb$'$ABkJN!#f0MD+m)J1l*UkTSjqIe-m1fICPT4
+"DN"#)4-TCeMllZ6XDR3$CeF[3NN19UA`S%!6c5mATFbi1'p!r`e'Pb'JNMP`4LC
+K*M32V2*,"fA&bq9J%"GqQkji9ZV)2i22[@Jm*i0mk%K3rAe4,)m"#6pcl)d35@i
+'`SKS%(%JmK3L583HeYf%J"I-2mBJL'%fm`Hc9['c&3[[5Ehc"m@Tfhi-p"i)rUD
+"IcM$-kbl"QH)$bfc0SK!4GY`'KX10h8dkH@&jFNa3GNFUb,QfT[dc(jHQM-QMUH
+r+&!,GE-,'@ZJTrIqq)9[VX-Jcb"S*X"!D@Hb3LcY("-)NXm3q$0$T48&lcCE%E`
+$aDH%b)D[TrIld6dVZh*jQUC,,NkaT5-!r#2-(%dCQ&%eeT@9(M-M5"bjGB1lJ$@
+PiP+*r$2-m&YH20B9LbT$(@PDMD8GBeh1L4L+Kbm'ZlB[&U-LfK8i6i@Sbr+Sb%m
+k+V,@Sk`[H"5fMZhjN!!JQIJC`)m"2ceJSfLNrFcBVFh3CB**fB!1Fm'J0)"Tf#B
+08&1@EJ"0GU@TK`MEb"(G!(i-q-PN-MITZjLj3##miPi#i!L+e2dckjJ"LF(UL1a
+@8[r[`iF%m3d+,1N)#Z3'QRT"QAS"T*%3*&U"A(`F')"SpA,`)%3@CXD&*@U4@@@
+X9-$eV-aSEDS6ejfX#hK#CJ%PQLNMFjN!5iVCZBQA9[4NTPXb[SMK`'J+V$&QGJ"
+&f-4q"$'S-p6)5"#[k)L'"pKke#5BK8PS25Q,R(Ij)J"4b@m*T!%$,kK`mib0%8U
+IL-CeI'hZ,Z,p!Uc&GL3Th$[e1`a&GrPi`mDNh'`aH",#`C!!,0l*JPf*pdlIA9j
+&L'+NF"3rfIJa'Lp0ZXk"B1)Z(frJPfr6"V489!d3`Vh+)[0G2Z245CdD5diDkbB
+YYJ3P6,91@[B(Qqrb54j,YLbcL#k1Uf25biQ(K%1MCK`NYPTBMXB@AA!*ad5'%XK
+[0rUe(fRh@YF%NQ&(`2qD2l$-i6$iKN)'lc@c4Sfif93GlNj!U`kjBmDaJ$f-cPC
+dRKF+E+A1DjbGkj`XTKRXC$ZLqhTkjccpqA!A2-AK#!l81)-U*F$0L*!!qdC%(m$
+bR'"bK[''##6l1akq4fmde[@c!)!#$%NfBr#*,[qDHr6R%3JYPK%dp)-YBeeb)i1
+Zd`9A9q6-H"2LPE2HdlJlf'h$ZQQ-L)kbBJ$,4Y%acpC8K+E5Sf$8GhaL@I53!'"
+H,,M3+Z2-Y"qCD9CH54l+2PITLT!!J@l8&GdmbF8D,VJm1qIZ8XlB4!abeLCQPjR
+a4lY`S!'&qA6G#VQ3!$[+fD)aqm+-Pl1H3S&a-c9`@E9rjG,!,rj6k0(8DXYD0M-
+6lNR+6%,)p,-53+h$6b0q,J,%KK4PN!$$f"*X3p@!*,hX4MXk1CbI*'B0+9PV2`I
+mM[0F*,#+3jqC1J&(liAMAHc-c`NQCi$6(Kd6F[,Cqh3kC01%ZP2Z)*eik`Zad'8
+ikhA2CJIhM0[P!Djb3309D&MKm5N3M4!cR@J`dR@VA-TiV!$"V&A+H$)6&4i+X*P
+`8$m2f5%X&3Lpk!`kj[QUEb!6fDS`jZ-(DQb-q36q0q0r'c,,c@"(KN5VN5-GL-6
+P"GH2JCU!k,B2J8ACHMcG'(CG"D2PUZ")'hkXq'Q&BU%66ZcIIH&Q4+*33M(U5'6
+RE+YZ'[rLrY[r*Qq40iKLT!iE6$Qh*hAK`+L8!4%[`5K%4'FdmK'LMRQ2VUXU9aS
+CGehkIliaJ8`*$#)*VMLPZSFD!+$KRaA-X3J2JZiTr#5)d,mUljX`"+2c(J`K@3k
+"VJRZbPdq+rqhkJPGfVJ!Q$!jaC00(3%rN[-Iqq2GXb(UI$Ne31bIk`!AKk(`A6Z
+$c0IZ0CQr!GC%@&afj2NCI)bYQJlYSEBI#J%QVUD3!&QjhlUPZ,"2&9!4*VP5#"$
+5"R`JciDKQ#9Ma@!&*R0Q1J$rdE%ViJ!bG!FL9m4j0"l!NGIjZ0!lr"PmAfEA3)"
+H!BEjG5cNJPPcRCJe#*T1CNeSke%ZLU)3ARBZ3-G!mLKP"08YYS#N49BXJi*5&J@
+Pii*CVb8))YFjL(al`,$Gk%`36PBP+&lNi)L-BFBP4j%AE$`M+VABXGRc((ci"m6
+HM'S8BEQK+'eL3m!HUK0r&5ScEibGdN$Q%AF!NGN6#$3$*EcF'@aqX&MBk6!*QG"
+aKAf48#)T911cPrL3!1eTT+)X!H'k%CmAk60&"9Z##lDr1iGK0R@MdMd#&`Q)3`2
+MS`5#@5I[X$`XH3F'`mp&BT&Q"*J0h-U!$k9AI2IlQS5f6`CqVXV`TUp`k`emD!q
+0G@MkT15%DcGV$U@5[#J2#+@8rAVm+,0%%UM@*#1V&NC@*(ci@GdL*l2+VV*YPTQ
+R(INPk6)D9i5dDBU3!!Cf#P5f8)&VcS"9p5HhH&0fbLRHM'`L)5!,b,-A2kj[X%*
+p(--K5"U'bdjaF3'4X!kAJ#"%!T!!,!MCdAc18K"kqT)X#%e8q4PqDfI('kTidAI
+rZpAX-$YUP6SbMN&"`ma(I`)k&8Fi'RV,'r*5*C!!KeZ%i9dTY--R9`Tj(Dl[FSG
+BrQMZ`$d1M89"TcNU9rTVKMURj4qQj`P6ESc9h8*GMNf`b2-HEq&'&j3[V#"r$dd
+c3*LK3()H52acSHDQ8)&Qm(rpZ"G&9T&Qr)2+lrE#VDQ)P3h5q+h2*!Q9Q+Cr8"R
+G5`VYXd&(%C-q6aSI+Cc3H$5S8Y1B0(lT&i@@63PR98!8Np0[hSclG$S"I'8rKZU
+9iPBmjf4e+0A4j*%G*ELJ[0%PkE1JH$-G#S4fRT6df*+k`&HpbE5(QD+YF+@)Q9*
+qCaGfV!MSRHVZL9d3PGa6j5NB@LQ3!'qJ3"B,6I&!-f@5TJ&m1JIrPG`T(L)QqQ&
+h"PcS8IaV`F$3`(eSqEb6erh)NLVXM4Y3(6Be0-RLb3S8QXRC3&JBBJNM501KQ"r
+*-RA#3C*bd)9rQ'jdS$-$q"!bBjZTbL1bU@ZI$LB`-S$)9#0a&@"r6`Cf63G8$dk
+f`%DR3a#baZcbjIMQZMpqiDMRJF-2p&e@Xh2Zb3,`SHJfp3fh)Z[,i#"#+$LcFlj
+UKXJh&0eENSi#32mhVHi"aj!!`L,4KaYe$i6miQI'PXQ1!f%`XRL5eDGT0a3"c$E
+QqlL#4b1FdHrq9ddIZbZLF"QLUQKPAFJmI[9F#`F@[DN$bP*rM+Ye0R!'3VFi1fI
+6h*5K**dAR)N+S(eEXXIdc"VCp18)0pXR0"Xa8"X',feU3'8!1"Bmc99(NAQPbU!
+3eYL&U5R1U)3ZX3[1bK`iYXZGi%3`%aNaU"jd@q(3JJZ*,I9`rY"ji4jN!"RZZ5`
+J,ZkJcMXJKLiK9Y!p3%CfCJ@a#m%mbP,%T-YU23Kl+``(c"e5Vd0M&[1(Q0MD2GU
+HHAf&I-J13P`lX*N`Q$iGJ9Lp51a(jEdPk+Ja$F85'V$2'B&HmdRU`@e#K8J4QY&
+S,40&q2&Tql*k))aM`!8p`rQ8I1FeIC%N-p5rj*-6%&Q#6!SB2G,qU)NC6Q$2-8T
+PFEi0+N8jf91fMSC*(I95Vp)46Jc)4#DC(IHP!NiBI+"SrY*a1&rNI(AA"(B81D+
+"&H0i@hachCMrMeqJJMF033%9jMBp`*93)C!!TjPkKP[VRB#AbB#hFDS&i"ePC0R
+LF(3SS'G(9)LIFCE1f$NCq(LCTh%R1)`L+HUBJE*9kVLE+KNKSji@B1"Bj[Sa+Zi
+K!lMa!A4+Br"M)02d-!%f'YB#G!Xd24*PIk,lCc51)*&-2EI-R$Je)X2(#95R[ZQ
+V6L(V@456l#6QaF*)-&D*Ue,mjV%-+-4G,4NpfMj+X,jjIF0&$,Tb"CEe@pB#bLk
+SrC5!X2ie9[[aJX@%D"XfmI+8`*KpZ"d9JJ+0"-,fINBJB#JmIId'"kcQ@"X)V51
+Lc0AjAXRMbA!D*(+!%A!beMUjSmP-(9%Pc*K*4$2*9CbC3%d0&N'RADRH,!FHG(j
+fGPeAS"@$pP*b1irefSjpHj5"Qj2l!$UACZGXf$J*h%a3qTMBq4!!Gj3!98q!HT1
+UF(,AL+BR4D#kiFZ61YXTL8b5Ki%9B)A+4B`S0XaPiXU!Zf'q'h!hI-+!qk8DMGp
+5()$,(&8kZba3K"DVlbZ&k"!*(bMF(c#0%[--bPNrd-U5e&AeIB",-j+p3f4GPjG
+hBDQ1TiZG2!JbILe`)NNqD9$IPj0`Y%XC)1HbQUI#+B@G6$3TCKB8T1U%dAK!*M5
+*'*l*!XB[KdCP4NX[#bDBF*8'F-KALfQi!`68,$"J2JDVS('T89BN3X4'"MAYRIb
+UT9qjbfIULF8A&)19Z""4#8FG9bi5KJ"mh03"d69-QpL%`0L-BNJ[iD#C&b$H[Xp
+%XeZiZh@1bSj"R"e-+0P(&%eAK+[TLZKTDQ$aPM2TR(@%3((DPR'FcJ9jLbhVq(,
+k`3)%DppJ&`e6-3S")0CSlp'C!j%2@L)'YbQ"&jJq-2-*E-H+JY1"UZ2AX)(+jdF
+I-A!L@'CUh-jkZSA1*,I-r0lS)X(2"E,dJ2Nf,M`@eeq!)Q!Qh1NrIH@UF1Q+JG6
+Qeei92ETT%!)@"PI1-,UcaDFSJm6E8bV'@e`kG3*J`S8YX6j4p0XDQfU,PR62)P#
+eSN&1PNJV*b!bkpf9FMBFQDJiEmM)frVQa%YCA%Jr`pMI`9Zf6h"2*)BH*fqqbBc
+!`fU`hP6YP1T)lC6J&Hf8kLY3Nd`*bU)&%%11Z'Jb(`G)A1P$Bmq8)%aY&%kTKV,
+Y4M#%V,8H$APSm,(MJidT[kc*`d-S8aebp3-@hGI%`2aB"PG09PH913GEYB*4#Ip
+J5JpB+iXA!(%!U&[TJTdQ"2"!fjA#+H96F['URl,h#SDC8Sl$kph9ZX'`iSTSV$i
+Hb2c)BCdITQV8mEIqG(Ya8)fFF,-eQ3MZ#ki+)LX!NMLQ5l96bYqkKPIp@m9#C[H
+LB98QX6@*()j2q9SfYZBf'Sb&0$BYX*RC--4S9*@P-MN5QSr)0[R$X`c*Xid,#$K
+@SBT[X'0'BcrF`j3ZAqB!lMk!Um)bk`h"c+T-+@#RF$Rl33ZcP8-',!ij8Sr+U)G
+`%)CV-6SF3r0rU"'FDCr+BNJICFP48-irGRZAaH&4KrpiZV[+Uqaq&dB'$'$JBe@
+rB"FX2a6GUU4qd-Q#Gi!9A804Nkc)j&IIFR+qY-XGCM3Dk[dF'*RPR'392ecRp)b
+'RqKKT(9PIf8@a0UZ#Bl2M9aT6,!l+9"CUif"#H9B9U#CNS@DRZJmcSkQ@4-6&Sb
+$!Mi`XCHM3+9$fC83a,42j381A3#RQ+0rrDpC(d()4R4fcUBdC-d3G9c-'K&@A-V
+KcVV*3%[9CT)6Mf%"RBGqILm$CdRkV55K()J[NXQ@I-5'C*!!K$V+2Jjb"2Y6@C(
+9pakCbZVpH*hilGlVILfF4U51hqk9XKkm+E0*![A5BHdCM9rE%meDI91%l6h#($Y
+q@G3,Z0S8*E)ibjML,12&d4CfeN+LA"apSMamGrGT(bdrrVZp2LpAlS",rF9`10H
+A1Pfb6hZST!H'2"bhhf&'Tj3&0JSc61ce3#m+HfD[K5!hhjQ"N!#dYCQk&AL"%3%
+&AVqNVA(Fqr%kAff[EMiU,)hUhUbfDq)`fc(+`UT46arer)(+%P`Cm$8%Xb-FN!$
+59J"P,XS6#!!,N!!K+'8",+9P8Y"fIQMEcJmYY[0$fhELf-i2H6YJ!T9+TdZUG+@
+SUV+ST"IAD0BYZ[dD0VC!dXSE8apPG4L,RCRT%5dTJY*53RV8RT5ce15J8IDi,e`
+5'C*k*-eiFXGHbkBDGBd[r%cGN!"dL"YGCS0CEPlM+cMA1#3GjQ@hd3BXr`@A55[
+"JEL1AjGfHim&-H'1[bV-"58%&hXjl*C%`1TF2Gp3BK!h3YT$KPrcCdP*L4J2CI8
+DhZ22JT)#F64dkV$KFrkX,i([8UJ%VR)`'i+&U596XA$16&QY-TJ'%U[R*d[#@$`
+Z,jCD,TkA&aHl&c0GGLJ'#S9Za2@`"-3GAUCFG5k52FcAC*!!Eh5NB#DL,S*-*%b
+S5*jHAp(CU'I1XG1qfZGd@qrm8Galap92kKr`5ZheMfmIM,6rpFKHhiD6NKm6MdA
+pFdjLiUp!M0)lZi8rlYhqqHp2EI*+m8[@RB24H,QG%cKem)jT8J-kR)`fc-QP$NR
+G0(4)aVd*+ILPM9kT)fr9eX'DM[)eGeFGm@hD*m8a24I6cp*dZbiIdqeallY[E&j
+aPeIbA0C['kccP,IGAER(Ya%+f9jIY+()'qe31MKdQp$"%IIq1@p9a3D[j"pjr0l
+"P2q[qmlklMSfBBX`PUAEMXR@Z2I`QIIUlRKADRMEZQ+`X3&AVrMBpm"*UCdffUj
+X0)aU4pdL(2F1DRTAddCAd8EA+"[ph,E4-p5K99H%$Uealp,HIe"TShVDD*[&4Xr
+B0LVTeQ'k&2IqbMGl!fq851iKNTpPNY-frFVdK'i$TLILhRdpceG`!K(4ff@LSi*
+rfAV&N!!!E4J4KIJ4h5jdM-5p1YeIhU)YVk)YVk%YFkGf)Rrl((a3PaVG-R5TLAX
+r1Rl(1laY5S#iNJ"R1!'+f""$Kl*YM@iZ1QMLh[YZVSQZ03(1f",J8Ge86(i8**V
+pckrqAENbE384H614JqZR52CH9,*"8YL9T"M9E8((dEMhdhrVqjLf[iUfldb+GC`
+8MB)6)f'IFjSkMHYfS00ih2[bDmQReT)F$GLfRFQ,LN5PFHqLcLF28$)m`FR`5cN
+CiT4JZ64TFGaEC(lG[2jGbAlT0cMHAVk5MimHr2Xd"B4A+X-YLhY6jmmp4q3H)R)
+h%lNrSQ5&SlI8AT6Vml)630chd`@I&frbJFaf)V09)I0+)Ya+*Kb'h"lhhYANq(F
+Lla0-hPr+j*8"eX0*J@QliYj3McAMlqp++qQ++q8V%NNl#&6YbS!liYi0(pcV*9)
+1%5QEPFfXib4M*bpTCG&*ZZ5QZ1qhIrrDe)dqN!$36L5d%JNriQ5LlGL,cY,8$A(
+I8lrlVhYCS6Q"M#X*+&FUK0`5pdljA[YGN`P*L--#&@"UIYblq$Xr1--E)N+Z9!L
+j6`iH&S4F&rFG1QHpIbf%E&!#REcaUA&[pcrpY12rJT!!dq,HXVpqYj36N!#Zf'"
+,DLFKR3P6&2F'ESA@-b(cKN!F*U4-()p#R,K#aVPahrIV"[B`'H[Y)!k6m5Yb8(m
+$8prbbXQX@r)Y&b'p9NCk2rdq0J(AaIrKLmCTbVUipm`r,r*5%ZqQ*'j3L2GVUH%
+2[ULITJ%!#rrrAd3jm()aeaJh((BG*X+e4aYHpd8lD"S5BZRGShBLaNSQ4[P[lTi
+&FTb422m#mY)N")a2hYR@`m'R[T@[r91P32Lp,pT18cE&[IXIq2qkL9LlL9J0YQ#
+a%KIhd$33DY%IpKZC8(bPQRC$VkZA#"@2VRcGHA%!m$[r-MG)"&K*52mh6U4[)a+
+5-2,r[[dHAEZ9Vre6"G(m`8QNVA([YJmH@8*JXj[!TX'*hRr[h$a!DmYI0FHF*)V
+'$3GG"qRDRdXVrm9jE34jrpkrG4$b@%QJraXPHH9Vbb6B%2HZhj,r,8)H6#626ip
+-5YLjFHqpArVQh46FGP0`Dh!APEE%4D$XQT&AbKHRC&Xj+GPN)J%iThhPe'e#c#X
+*e(rM"RAI-H95)-,LKk)p4+B@*Y2p0N$hR95)J%6TUp2pNC+ZMC*1EiNZS[E6#-L
+[8lAiZ'r@`JXrIJ!"lY)DfX#U#HKL*DEDDHVfZ+rXeCRI)Q643#6El8B@[V0ZJYc
+qbc06L'3Y6,,lEBM#PkZ3!!0*p+rfGGF)6E34QY"ESSPS!`ledk'lS(Vikq,riqp
+&52!eP1#Vh'M#GmB0bXGbrre")P`$%@lh@JL(!(CVm1hdRdJi*&4DcEdl*K21L4k
+)($,K&XGpheAlV%bi[$@%(PDjdB10(!$Tl15D$bL3!$83DYLYS!C,JL#J2CrapQN
++(#dF11kAN81FVQm,q'rF@2iBJp")'kkr%PHE44[`@f`!)&4hajerB&)3`H)+`8l
+bp8%`Ma1XIhRflcpL8P"5qT@N221PQemG&2jl"NAbMN&KKk"C1XP")cNLJUXJmJp
+Ypmi"keEEKma"d90H[h#dA&T9j(h+pkM3pYRl)+aZU"HA8Am%iVA+$Qc-K,fdkTV
+[6ZrG(afkImUkllaVe$2$Pck+T0@lpPjDpDMI-#F9bMapl[3d,`qFd05)ZrINqK+
+RF@M$R5IRq'V8U+C9l2SSi6PqHTT2QH$phCjMek+H8lK5Sc+KA,rPT(Z#`H9bmC4
+-6)NFG!kKY4JL'2jGmE&r$2CI@P@q%PfpdG8rrHMdr"SaajI`APU9m'6K5P&$p1&
+Ui@cih8FRVf&k-df(I9CR!b-EENTiH"[4KpICQR")pmPV@FH3!,AV34B4iRcD,SY
+-"l&6j!bXD*&C+fTFB4[J3qbeG#&5-Zb2+eNJ9!H5I1i&UK"ddlf!+N%@RplClSp
+[Uq-DTH20b9H3!0DiXe51)QQ01p[&Rmi-'MiHGbpr@af8)adq0f1MLeNU8-G1@CG
+DRDG'2H9GZlVRR+haE$Tla!XA"2pP0HV(dV%krmCMHla[3rfkI5q#@bX(0qRaYh+
+$r8@j"qqI2T!!dYK&X$rUhr(4(0r"qkF1R*hI+U*qed($39ji6eNS$f-`,%bMK8K
+(p2(AFhQ!,f$"FS!r64VJFf9"l[jVZAZmTU21rrYMfX2f`j5*LdNG1rG'1mUl#1Q
+p+mAa'DF2lm!p5EFcRee5YKaj'5iG[ZL'epIGAQ,"&TXd39T[18&AM`UVa-aJ-h8
+!SRS`4UEAjUNA$J9dTE9j(mhkVlm53ir!Uk`6TK0+Ic1XHeDSH#d4)Ebq*MaiP3N
+rANY&"ejT)SkA6V52X!1ehKK*l)F6JGeKC@A2@bfZ9JVmb@Urb4VE"SBS'la+MB"
+KJB8YF'I-9bi5,3(EUP9KdHJ@X4P$VY*)94X99Kr8IISQ2a5PCdfN(JRSZpJ)mN@
+`q1(!S"P+#DMpNeaP(DV)Lh#I#-P!!bC'QYdX'U%QUK20[+J+'-"6*ZMB08mm"ZA
+[k&`4`N%K1Q5B"Km&Ha6ZX(Cf*%Z,18beXjD!L6`r!a%d$+,K#63NAI)#M!2"@`j
+94K'"Zf6XR2[!3(C3I""0XA2T%RECD4V21P55KFd[k9iU`F9"Ym6YJT6UXTq8(Fj
+6XX0j4YrpXll'UT%RqQBYBAG3B`f1k0+Ph8VBDi9ZeT,VE9TF!3%6Vi2hceUbTSV
+9DFBiNkelDK1c3Id'fE9iND'`1+[lqr5+Z,5Z,)@)IPH6Z+JBFb`(Qr48fL,$F&V
+CB$Qcm3BrJb++U`Q*q6MLHUF@8DSfa)`JX@DZq'pKDlkpdqRNJ3'@i-ILb-%2q0@
+%Dd'Pd+fT,6jP+-VbpD1bIA'*SHJEL!kqLNZ+`9`fHBR)%5Mkc3m@BQ)pP2S(D*!
+!'IKiDK"++&c[-lTZ(##c&84P*Zkb`A*8F8kN6M#LP"8ahIXiJ3cel%S+XeMY)(*
+j`Y#%EF&e@LB0-hQhXQ'"lZr,LrfXEUjpicSYXR%jX$,I+'!LG[q)#c!PQ80)jRZ
+Cj)3!Z8U5J,ZB[[XN@2eGV(JEr%bHaXU%PiX5*e*+B%aEl'6NYp9@r&`Q0Ic!#bZ
+jZR@%(&RFVZZRS8lpN!!E64(eeB!,%lkZ+&A(j#i``6V#894eUHpENEBB,0[KY-@
+mC#K3&fERr(DU6+kJQXQU@5dhZBH*Y8*4BfILK0Keq[,aG'8kP'HK&,NaJ*JaKf5
+#1iK`EY-)-`(IZfDSAmQU!6CXNQIb3FPK0ARBp-$h-Yf$U$Z9aA&@l6$)%,-C!-0
+9MDPljG1pcZ[+`he05djT+APEkN)q'ZkPM3$%j+5T%CK#FQre(9D*a+CqHi5jGck
+jVMPiD3d#J[TU24[-U#0LU$)aX0"L)hlBJ[Kf*e'0E&rmfbDTf2+65$TQGT0dDCd
+P54p,XaMNTV+ilB9)kJBP0MVcfaCjdk*H*NS6QcT@j5jXE2Qhj`LPYJ8kD6"-4R@
+TKF%i6*9ENXCKfjCUZ5h("#-6&NBET%P''c``US'!(Y!m)lZj$KP6LPSQL3'[!6M
+EaM$&ZFL'IArl'V'B,Bcq`JM5Z(fMjV#8r+!6CM,1X@+aD6ccXp[PV(lVRTRU5Jd
+J+28P-NI8M-1&)&C`&E0B3E)N1i"[paRpMTDALjLT932eTF2$5T8fJ@T2N4HH1PZ
+d6A010BlC1m5URc4pJqAdT+2MK1#PM-293PGqCD!b+!d!U!rLqZ8F$Ce'Y2kP20&
+3QAH&M9AV+YqQKQYS1-e4cpm42F[4$LZLHc$j"j8Imq3'AH90DNLJB5&(ilF4RFh
+4pNm4I4q6QbYRmZ69ZXSCe,!!$Cpb02NmSX8FeBmL@N@AH&1ja'[8B%$$2)ifI)6
+SA)lDTb0D4*1R+C2IXkab)$RCj+Ua@FX9!KeVhJ)X##eA2&pc-F3ZKEIZY94S4NM
+)6@i(JMI!LDUf-T9GZDM890[G*k[VAB99TiaC-)54-ZAH'NMjZB$8+3@N6RI&9"@
+ldPGe&9H5ULkp9&Jj[HUmUl*+#c99E@AF8&M9#lA1-Kk+!m2+(T1!dfrm1e0QRaa
+qVEqfkK3@0E`BB(-SdbFB6)'cE&3aTTa39(L55h*%VFLJVhR,Qr+b%HCSM8$@02U
+3!%#fl*'$8!@Y5Dcq$em#)ZKETk0JR-1PlR4![h121-hB`4MDZ3FZrIl8LFL*bDB
+N&''rFDh+UQC@8ke05F9%E!rc*D'NFP`@jB)&ikap2)aVd"r(6qL5L1k2HL99klX
+!J`q5QX@4T+5HiSKG8NXiiT!!e(-FX8VUFBk%*4J-4D5elkG#b[6D[BbS#ZIPm@"
+VN!#BMjD)I1m@AqJdLbR4ef[%)piDS6f@FiBGbNXqdTkeRk8ZGmV1*!*QGX)lh*G
+HaB3P81',*fVmS8L02`i(eVh'4ZeTHGJkC-Ff(!Y4"E`DcB"ikKKqcYC!Q-mrbdB
+d1H[fqZ05HmBC1&C1ImMP$ch8iir$[A+Cmb#!3T%E"4%U,a$Rb!$r16MLSCNqXNd
+FeI1%+`A#@&A%LG&8LmijiJBA%e"%kib4&*Ci1dd4YCNR)m)+IZQ+ZDSSNb[hkcJ
+UHG`SLee88l)KFE[4JFN'L*(2`Q#%$SMm3ll#'lQ"q),+@AZUGhkGLM)f)N,UA+T
+UG9IPV)q9D9c"(qMP4rL!8T59X,@981bZDb'h(`GGdH8H4&CqXfN56(,PRma-*c0
+@IP6INJHd0ZQ9JS'R5$a`C[T%%ca1-@9%`*AKP1@@fDJ+#H3jZKDC3$"iF0eG!5h
+L0-FLX8QAL9h*5-Q-Zma8b1HJHL9A9H-"%R"Y(Z0#e#aL)@hILlZLN!$B-pQNdCK
+FD6$*,Kka1P0KeG5!!`&l+Kr6H2SPFp9lap1a2!e"U,Ei@kLDb5*Hqq!MTXS+Dm!
++Ca'3!")GhT-++kcC0q'J&G*iq[(!!S83*'!+`Bj8`Ylp'kR,l[ZXr(U-c6he+`%
+AfbP(4lm'#qJk40hdG%')TDPK150$arI59FbFBAR1&a[P,!*938BP!jk!406$jEi
+GSR"NmT)VJ'Y1khiEk(!D,Zm)X"-k$U$#8Yk!3pj!8(5CfF8KGF)TcN2eMSX'8K"
+(pA!3kk4VF#85')d4H[I!E0UUSX(C$49KC!GVkc2mD!IhjXqCDLXD!Z11fUTYA-`
+CI'2#K58L,6Y1,&'%kZ83U,QU6f(9YZlcU*bTYhfHi)G&00N)Q,E&dB9,0e*'T0&
+'HSGXrTkhb0eFMeLifVHCDUZQ"fJ!0%l(pZhC0ih06N3U,p!`5@a&Uf3TN`L-GRU
+3!-0!qQ%LF*)0qfbr,4[i@ID,IY%p-h'#0p$Y5'PK(L)%0diBL5"(6La$J"Sb&$d
+D3I@E13Yp#le`mGl,reIXc6qpdiI-jJaf%fXSCT0G%"#dlNrZMNF(1!c[SVX9hEd
+,I4'YaSS$8)6`!C1(!e04Lb&R[S6UJ&A6m)T@6Ed#mjm99V`L&3kU11MJl@2,U#`
+6H3!"a1m#B6Jj%0Q@R90RT'e#,'@Rbqi6#JRRA$P4B8HQaQHa1&9aMZF(Z(c52ll
+p0T*V*LD9ibF2J#)3U@B"8,4hEfZUVE"EGTCkB%Lq@1U$8Ek[%'$"Y3TA'S#3!2N
+*VZ@L`C3$-&!3%dleMbrl"6lU-D3(3hUD110e2$[RNHR+%%B-SFF3TpJYerfS!D"
+ecYS&%!"EbD8rE(2VYa@MDADEd`NKA'51Rm@cJA)J+iX!6,)!42!!$!,iarNekeQ
+H-U(DC,dkB*UR$J4kU$*%R"J-F@)`T,"J9E,f,Ibi*BAYeXL2(*'chFJB02p(UCS
+CL#Hd%*cR6N5XXMNk2*UMXU,PGKfZ9B-Jp4aAjj%E,YAQHkqB+eU-cFkPicjHF$k
+fT-PM-86Rl3)JSr'[r3XlG$*T"SeYAE&4")%EH#c+C5N6MKmKX(J+4"`!$$G1'%*
+*U`jcKAa%bkUEi4iIeff[43IGYK%9)LeRTI'JQar!IA$#"6SY(,9N!f`bF@%Hc1J
+#1iH,dK[C13pG"M,faI`1Ml&'dpH%`$YV#BSH28GXQA)'T'1FN9$)lcQHlK`qE3H
+l*6S0pDINLK&$9"'cC9)"akj0j$S2&c1ZD"TqdB3@H3*!D5iCB"U6A8L(JM"a9eZ
+4B)&UqAbZkSNUZ$#q`PAN191d*S[GQ2eT9#NN3K11XJ%bb`+*-fK1)a42Q#X5cSa
+LE1*3HKS+4V0hRiACJBdXf-DSdM*!(U`JVMD),-`[,T@$5"&0&jN*r6+*T"-'FXb
+KJDU*%%+Ni3T`NcE8FbEcqDNm,,+qRFk"%6"$5%D)dNp(P8(aq#'UaPVpNVQipmV
+9d2@+mhJC+miek9d"DVU[AmL'"H5)jk351DBd9#2bK5)BZQVLSXh$&FJpZi*QAN)
+3l3c%Vece[&eaMX%#$Y!0#-iTQ1GbS3$Q6GZTmLHZY(`MUMV8&T[QA`d9"'TSHXV
+TRUb!aQP-mi&iLlJVR"IM-TJdGI"QfIPhp3&+F+'fd3"iG*P-%$TUE@4SPFQ`Y%F
+QJhT1*S1UC6+Sf8`'"KPUI%EHX2SAK3#RP8LZdR!1M`3M83G2ArQHQaLK$DKBBdQ
+-baAR!'VcU&UchTP8F'HG3+$I4*'9lV")a,83#JEYIL+K(*XR%JV(ZSJ8)M4+JE4
+&Z@6PmYQFT@C5P0h)B[C''3H"4FY-3RERKCRr6f%FS4J9C+DaHkc6-CC-3c5#BE'
+3!,-$6P-U)D!5h9`JV`Ziq+1)2"PSK,0Z(99aH5F34H(cA##DE!4fR"YS#3fRkD!
+1((jV"p54r(V('*FA%E3ZiUF4#AAHa1Dc*%3()JBNhMcm[)EVXi0l#EfB1@6&-Cf
++@E)fZYa4jA*CcX[9APAEG*[`DY(Yi#akMIJk)h$2A*LMi`GkCHFNf$M0*VND4b+
+-MafCkEaaTr-Y(6!@1)TYC!EUH*Zaa#XpD6YUqp*fJT9d,b15TkkL+)cJ%i-mp6i
+,iK"#R-6q4+iH%fM$81d`U0$X"%aXie&0Pf*QS4jXi3JjjNFBKE#jNjZ$F"iAXS$
+rTl!Xi-Fb`5L1"%bBIK4*j#)QD3f1q6)UJb,6U)Z3!&Q#rEUMr!'A[`&brSmS"JS
+bXEAMf&T0-$,$50-[b!J4,+EDG9q8h6+cFqb2)YMYc8)3ZbYcSPR8,JQSH!K9e9T
+KU,)6U*Qc"P(*3iAIXN!5!NUif!`"T,$Bl#UX5,PUL`0"Hp(*Q*dQJ3H!i2VS5iF
+V5j`,U$Cd')X*QAfQ[LS,Nq1#+b!jMBSKdC+)C$+$hG5$`JCQ"-"U3@Am0Ul5E'-
+(GRR3R*30Q%#B)d-TKXaqCLM99Tah&JSJaK%'(k0TmQ!mT5X#YQ+"qJrrFi04`%c
+LX5G!!6rSPCPF91@jim#BVFScXYRihmJr,afU5#&Bpr,$VB"!9L(Ek2K4CF9jc5%
+Tb4(M%%eaIM*ESX6LJ6!ER48'f6!`NU"jK*mid[9c2jb4ZlKU%aGCR9XS'Zp(*BU
+@)J+J)93,q4$ZTaZeqfc6UV4p9%$M850F3"0,F'0pjfcc$EqQ!qTC-B6!m5D+Z9[
+q[q(",c4K"i"S"jMqME#Je1KFe2TiZ@pC8Z$KBc6-M%ClRqHhp0LZ'PjiX*%H#1L
+m9!eG5Sr(Qj36ial"Te-+)ZLl+m!Y06K9c#`'0,*,mD3#1'A1iia(JKfB`H!YF,*
+5BBUP+kf!c9qL-JZLFK(4!40!D38`(6'#K#T6N!!Y$+4%J#JB65`e1*(FdUf@#'l
+TBLH+K"#3!'68YR44c2C`Vk@rC,3A3j@STEmF%4C6QjA--#!p%"T4rpDhp&@)9N0
+1C,9dSI-3[PC61jN3Ma)M9Kr3bfJFaEf@8%Bl6`+CJNLQaV'ZJpJXh'pP4(ei)U*
+Qe,l)5%`ZiEFHa'BQ)fd6VKU)dlAM9*hd(5bp'Z$*#eq%4!pE9%AJSH2bd*iF"AR
+",-l5-NCH5m[@KVbQ(9H3!&H@#4-$fDkUY#'Jd$C'AQP#39iA*A4Rj#9[,'f)&fS
+cdb4'B%[,C!5@PUJpR+E"&#%M-(5j`#cL2jFV9iS!&"kqJF*j-UXL*8M-Ij,"J#U
+UTaRY6NB-2TG0B-,F1i%*8r!#6*J#Q3R6k('cBA)@mNDC5)YhbPF+IEKfCNc1J[`
+c2jNCNl03CXC-CS#N#-#H&a-Q&p"J1I&26)H)e'cNe-bQ"Gh-Q%BR-kBaia#f98j
+QQh0DZ%S$&(bk)%#-6F"mI!5"L3-8+`-J'QbfRe'-#"@BpJAB2'cF+HUbdXX'JJ"
+-hE4AmS$-*S$KdaYP3UJI-i#L'QNTJa1-f'qU(9jUN!!,jC45+#q`&FUY0pf&FQZ
+ZA#L[&Bb4h)'i')BKMlN[$-!["RC,F(jk9,kLf)VU20&AHTCq8RYikDF-KJLJa8%
+c9heJKXE56b#Qj8&TA9N4#BacJ3rb@@m)9,XpK)S$iI'1jhVKQ*qmTFrX@p"EZ-3
+)jY@#3i9,j+Q2el[3NF'6MB09e!6DF03!MXV'K"S-2i"*"j!!5EkHF@J#q&A,i#I
+9c[SB*[QU1GRNj-,MGdVG#4RH$N"""E$3m-3%A6l2)N%M*!D+T9B,"a-m8U*9BHm
+a3iV0#BV05*!!%IaF`UF@%HN%Ub#22)G+R`#*)QEEi('06`bfDET'@299*F&!fe[
+h9pa!3Xr!KQi-IZCNDXP+6hlSSPdrST+`kE1BALj2"qMZSD'Z4eJP6kaH0[$'PIl
+YIY%)4DYI2)%12BSkZlD#JP2h[r1$2H(ZX%+hH1C,84mhZ!,GrbkM6KS5,$T8!U1
+U2Gde0lUi5)ZJdQF-9CqjSIX90NF2S@UaSUU"Z5YQdXJA&&ZB@3@&'mcfa5iL`6q
+Y,4bFcYRN`FhdQ,)bCI$Yh8qk#YmB`%qf!C(")#CVM9P"$cV#a(R,-#Tdk@9RRX&
+rTSHSPLVQEjCe9fZki*UJCe099,NCM4$Y#j4PZlaPTdMrH"Qf0FjNNZJaN4N)d&!
+Zj!BLV2*'P6@qH+Y-9M6!j,Sl#I4l13NFE(M)9M9)b5!R&DD*`m+e3XR8JL9RY6%
+$diMC1ZlClQ5IpA[i`Eb"LiTUh@1K@+pp`bJVbeNC$NDZ4BIMkE(0PU`3C$jV+rS
+4-'iJke"CBFBMUj'8h9p(S$(cCVUYL0k3!,H)kNT*C0re9)N1$+r(Kb`'kJ$$Bq`
+TJ,0BL-H6,Na%a2Z[H@208B2dN!#B#E0VX`(Heek$m3ZHk"S8Rh!NDVK3)"D+pr'
+D,@E#!02Xep"8@'!D&!Y[2BU+%`XP9'$@,B2`fKB0lI!1M)ICS-D[TBiG[J&c@$8
+14821aB&$@)#UK48PiYHhiY&aQSTM(MiSTV2bC5!#be3,"r+5e!'2mIkNVQXY'jM
+p[q-'H#)Bi-N(#m60Y5aHXpJS,e9@'*!!h)CE3$Nm6DUY-$`i+'rp685UrAL`q@c
+Di[mfa!#J'ZUk*P8mD`CEB*lEI"FV*6Q!mP"MifVAK`ALBa6NeI,deChFB)r!H(X
+eLkp3[51+l'GkJ)hCHELCTlX#6H1RNlSGJrr"PC(K1UMLXEi$%+S+ef82(KRYiQ*
+%RXSZ020KN!$J`aiM%5XM)USR0`rIbafGLpNj1mFc`BUc-#&QZc)Q$-KA(@,(S#3
+2%!HU)X+BaFH6ZV"k$deFE%0SDj3CqC-kQ5b""4UHf6C92e!a(XB-TU3T)SCMMB3
+-GJ0SN!!e`dF2+Z85XS1M$9i3jeh1"qjf#FXQ,Q+3!!3jS8Y`Ri5CQ4!cJ8pCS*T
+#'G%lMG`4+T,SN3$SMUdDJ)cpabPVUPak(83Z2L#+"$j&d3X[*KE8M1X#`e"+Ikm
+i#bppm5QmA-8PH$eBI!j&49Da9AD+8NLl@9j`ZNG4i)',9(k"Q)j$Ti*GG8TaJ#T
+miebap5@i44@IBc@mXm&SHZ(M*MYIdG*heh+)20Rf!!-f'J@#aCf1H9#KePB-`'4
+6NXfrfTM3-*4b1bCr3V%`)*-"Kir5G3i@Pr"4,a@)UF@RJJem("me*KCJ+G$iF*q
+B+KQ)B1b@Z+6iFAQ,mP9Xa)a6SpA0JXE3Il2BEUhYQ)q9EA`Afhd)lQZ[1S&h-(G
+L3L&SC@"J5Jch0Te$fiC6KRmT6hh)1654,S,!@h4*RqrYjm,d)GY"eC-2`J!V,Di
+DYPh9C(&9Um99*HF3l!VCZTEVbN2DKP''a4A$PPFFMBKVKBq1qB&QEYl`Q!i94T6
+XrL,1lLZE-&PX`NS1H)X'Fbd-m5f4A4!S%p92#0IKLSJ"r&6M4hSBJVm`d1XD8$&
+FL3&+0`e&3)N,DANk)fMmc-62q`qcN6F6[6l'Ud&-"EXTB5r8kGiBL'8#')e3Kp8
+@AfGe'&GL5lY$8QdU-Hp1hd[Q0l,G+M9-23pe@Qha!9DRAHVHiKh)Li6Bf0`@hdZ
+Z0`CSB#eBX4$-hXKm#5mN!`3eJ1%hmN%QJ'%*"i#i@Af)3C)$2d5rBKBh!-Jp42+
+,p2"e6#Iea52f`RC4I,c3(qaJPD%3HMa-Rd3J2)Upq"#kh6"U[[dZhDZjLicXj'5
+@8BZ-9Q684%52L-'(mciI&C[TP8qN[C1$K)bQIM$Ma@K+38CkX&128c$#),&4J-S
+2#4J2%hVBa-#MrUhih$1%e!K*N!#!43pY`UXl#eFd'aRT`S"&p`N&4!FjLf%I4VD
+Pe6Qi8h4cATK&1"LX1`2!XJrZX9@T,V2F,Y65%1N)Z*jMe@A&FicbFB#M1c)4-6[
+CATa"'LIffr-Em*-2GU-"$Tl2ALQX(+S-mHXVD@!b6JIEE"-l$VN+Zl2`XpP9f9f
+0RhXY@@m"+1(r`NE8Dll1,lJ5Kpj1JF9R,a6qbK)fHbXE3kRc5"dIG(,eGi$(qcZ
+2`HL9q&PTp6BmlUHjET`rf&!,-K#q5%I1b9ZKL-G3f2d1e*PNPY@cr0$phHpNlXR
+F3hrk3-iZBG)1PrE$805ZHC3"0AkBLmFaP4#l2""S$D+D@d#[!3X9MhEBDi5ihd4
+QUMI-c8aRGkEqpLBbqqK(&[QIAL-(Taar&E2i6#GPNAm)"2R'ZchUbqr#B$SHc`e
+6-$"qS4E"HCM0cmaM"kUIP4BQjFXE3h8HCCJ#ZRJ(,PjELDYk4Mmm*NrQi3Z6%D8
+$El"b(6U-SN-2EE5f%J$K5AkBLdY*TQ2F!F*GNA2Vf(*CIfhhCM428c,GRp#Q%l6
+T6QckQ,,T$YTd"l'3!(#*1pkcEEY$ZGCf8bk6mTB4`rGB$!pfb$r&D2MH5B1rQ+"
+di6ZZmZ#9kiLNmKD1F%DC-N%LED0-&Sp@hUl("(#r$-!p"m!VJ6*Z'#"q#S)C@*U
+'`QH0q)&Ca'Fcm9-#JcV,aPJ!JA[CRjIc4"2BMB&aJ*qKe`aNBi"E[#p@BkQ!0[,
+M"286e$YRh3T5r1N!PFr[3,&[+$CC'!NVC3-2cNI2!i'G(bEA)K9(9D3-4IPBBQB
+d`091*!"iJ`L%L(j@bYA-%rZJ8#K6f&!aUID0A"6RTGA(D`[Ib0@96A4*)JGe'&)
+1@+(JA3q9!4K`[eXFe((QANbIj0b8`j9p`EJSII!D'`AL!fl&DGM5#F1@XK''j6Y
+'RDb`*%pR"PKL(dIj)I![X"NFF(-[6+SKNK*r4,1drm%TF#Kc42I#R#!ECLmE(S)
+"Q[8`53ZQbHpB!DU$*SZ"`djCH!6#lm3JcQ%M6er2cRNHMiRJLJKZ3aDi+"J@AdQ
+$UDA#Vd!NV"`#-1$44'PRLE&T*kFV1dr69PEb)j8FEPG9*@%8pI8#5KbqTY(XiYH
+0YC*B,a-MGVQ*rMb&jCZGC!@c1[BKYS6(`CDj@CC[j!l2)c#h!Xa2a[b5ajJNiRM
+bpkD%DjD`IimIp4@'@FiDr-%EdL0p)J%d%&+'m2m4,aK'fXJN@(i!$&ll4!+3!2-
+D((6Z'5$R6)rXV'[KR1P(GBmSh&'5h3pFkH[Hb8kBhGZJ#R*dhmA)"0II2JDL-UM
+F-cdVhF+"J-3+Cr"9(Ti&BI1H6r"RB*b`I-3D'`'Qifh1`T-ZF$&PiSIAQ$+'bmE
+UK!1Q2[(RH#!M,6h*Qdr!S+`NDKlMajb&LB'kAEN3&+#@Mf&$B451Y4"i@)QScBT
+,#B6$[m2&VBQ(D#''b*!!M6KXrPhPMP!26AGh5*['"G-)XI1EqS6X1%%GZ4+mX#-
+$I#VS!%KVjFFGfJ6TXYYK'@hmRh-CE5JLY4C'fUCh&Fjk9Q()**@JckDEq)p0X(-
+J(PX0Nq5P6&EA3MR)9CbrCB4EahPGUE(%#@lpUpf!KU#Fl1m6'J6ADc,!,6[["MJ
+djZR@SlQF3A4X8*M(!+E1B-h+UHm82EM3aKKA8%IKKja9TB#YAh[!TL!j""9E-`I
+,Vll@hb-Z!S8dba-UcMqi%%XDbmSS3J$%QV[cAf*!fi)2IIF+&1SE$k*iBADc-`P
+I21dP#%S[RYMN)B1*5A+K'arqcqTU-YM&Ih,'H2,*`EDa,Sh(%P39)k-`@8PGQ!A
+UjfNa-MUNUf)3RfJ`e0R*G#f@$2*$0Ih1l+Q&3I8hj8#!a*Z,Rk,J1)"K'U*616Q
+0jD6JRDXBMl`aq+p3P4MY+*&kY,SYX92fULmHl-[3EBJ0N!"VhbK0Ia06[dG6)r+
+#-X3Id2!+06JJ$2`"jX@["8-`&HBhkK-i(SmJ+K*m`6Ej8%`IjHP3cq9TaTF16Jb
+3!1aHc)3,&[cLjh"(H%3chP&,j'K*C)"%9PZMRKT9QD#@3Dh*!fIQ*0`3qI'0B9X
+(,[kiLq!Z4Z@aL`UamXN814Y`T-Sk#'+ME-J1%3eAdN%%5RK@)+4*AE)6iKCm[%p
+SZShqe"ejkAUBPA0$dJrUkPIkk8mqb8F5TYMd,+laf6"RrEH`HaMpU5`+1-4kZ6N
+fI2d5A[mCj'T"@pRSN[a(Q@M''k`d6C+[YR3G!`3lL-T!a3%Z'"Um--B20S!KE5k
+B)&c1CQEcc)Gik&p8rqScrQabd1+69%&MPqhi'#A,iUEa@[b6Qq)1DKU3!)Q`p"`
+GH95Hb)4JC)PNG-M-@GH20H-rq)fF5$+CPNDSLedQhY)@rU6$krKKX%!'qB`Ldl+
+NMRHr$rFG[R+F*Pb3!!FSfbjh,GXKAk&XJlcjXRb0Kp93PRp+LG-BP'ci&dSb3Z*
+2hp$BR+4PXlp0XP'XCYRjq@QcaKB%Jf+#H6#UjKJGF#TjP2mhl9E4GFXIKKSm-Z%
+4SM-[@$aSNajJ!$#0-`+!'[GMSiZG@q@+Gh@HJEc-$Q3JHqYlBIB!TM0R*Q5MId#
+9l+$F&Z`Gk%$*SRf`U#qI(S,3LdGF6@#VNk0`FS)"m&kh`X8YV09,VJc1B-T'#X@
+EBh-*E2%(b$!,(5Uca@aULFNm'*6r2"Fm0(UaVT6r2"Mqif$J[VFi(mDYi5"DKXF
+h`p3e9h4m*VhiSF3*E2!m!8-T'91+FZ)-&X0TGTc4&`$M"m8eq'a82PI4Ti6(%4H
+)0LN6D&lL*PH!'f)K9mD#RZV3U)F*9Ab&Kir0)#1#LTL`G"-fNNhZe9m-F",IK)Y
+Pb(JH+Yj0A*d*J!4MKdXh-I0*[B+NEH02EXl1qDpm1"q#P8N'HVFKH'r&$mbVT@h
+L"qAMSj5$2*4fQfDHCq"aJG&(RdiNLMm@3dJQ%@YM&dKbpPV@rFm1Z2["m8B%YLR
+69K!j9J4e6FcQq"BM0aim'1,L9bB96m$2mdj8#DH&jph'ReS&6,JPFI4LL-jfX@[
+QFrc`J0"*r[0E)Kjkb!-rN!!U,Nkb(G10U&`r)3LJ1+#+83ALI4$BNG9(5T5AX`E
+kfDPm*LAC%#PM1%(`U16P#rL2jjPBU*!!d94rprq!3(!Gf@3Sc2R9j"KmMV)42hG
+1(-a%4TSqKF8r!!!aL8&%3e)$!&JL$e80CNB4%#(MlQ(rEEq@U[6QllUqZClQmEQ
+ZUhUUYRT"md4f8MF'l-S#[@iQXl2)RmI@mT!!MZZEZB83`KAYjjFGF-U-L%k21"F
+1%fZ5m6cVC"kh%&l2`RU%F(S$)i6P@BI4J)%Qh56[I$-HkqrIhrrhG4dJ[lXNlb8
+[2`!9GeiNmb!b)K)Km3!4)JCIH9dQBc(mb,jQ!D5B(-!Q)BKQX`H"NmbLmmfF!l-
+8X95#lmhlmli*)rMlcS+-ph$eYPU'2+,4)ke$(aPkZk&&6Y`1&bTLXGrpJK82JVP
+f0GVmR"(XErGEI&m[NNB3i@YB-C!!1Ye!&S@"H'%JK6-)T!Ymk3NQFEkFfSU!X,5
+r4CELL15B1&a'hV%qjhLMIm!r!,$pBAmF2jI9VFea+)[+D&"DI'-`dFVL[`Cm&ZB
+$X@3%V1"bQ($TC")QE-*dpm0X%&AMCGlX+IjV@i5,C@L98J-b1$eae%FYm6%Z2U)
+Dm8Fr-Z0!'LfqeU-ZCG%[*EF#)+i6Pd-J+Lp+e64#[qr-+FHA@acG+BBpJl-Ae9e
+Aa!2DlcXcbJ1GqJ2DG-P4PqN4Pr&a-U,+NbTSRl6)RJdG[QCe`Y"X,E)C`A3c313
+33FGe#,(UI"PMrP'E`fmNLl@T*4Re2qaT9QZTq+1fTEZf!6PZ'EI"F+Z-8(mA!))
+`,d-3jk2P)4,)3mE'`@i[S-D-J"TCV+K!I`H@fV-p$%B-ImS'rk(&8f)%93)T8pE
+"TD@,'B8Nm&+%FAD%F&ERqF,bVGf638jG)2cq,(Gh[q8*Tl%F5V$9Q9GlM'4E1d$
+MjFSM&j9(SPJDf(Yr00MICB3F&X#kjfk(e*f2IU4U"Hhjqj0*CB&I,$LlbdJ+@*m
+-Y)B0P-2)3NjU-%1lVEfahAH&64B*4+dSXZZ,lNL$CF&Rj+6CGS+++5IYE5F+qH%
+F"a2Cb+6%0*@B*X9dFVN,3-*N!*IQX-2+S-NB$2E2lj1UZfAN+`J5AFc)m)V6dk(
+8k9M-Pc5SX!%YRN!UU`F-kF2'aYfXQQUm1@RGHD+`j&fqdf)X%E$'m*Dfd`,ST1k
+L[+`"8V,ba6pV890,,mAUr&QA"2RTAYDp81[@QVTC@%MGD0iiLLKXL'lQa5C5cQX
+b$!-+1,TjSCQ9+!I&"2Hcq0*"`p+ML`Zjb[3#%`A%'m685Y1kEE"q9SQ6%8c0a(4
+#6#HPAPMVAP3+UbU(B[SXUdmQ`edNH2()`iVJTEa1KH4M!IRXSk(GAmc'SHlPm$`
+A`qX@G4Y9)ZT64d1m`5b5([6!Tq)"YrRl08L%N!$!YXhc9TV1EEGJdkdXAKKHYj(
+2Q4i[AiD!mCYc14N@S1#8*QAE#GkBIpiR#[-KeCr*5F160&*Y(5aZ056J3Lli59b
+m$jANiTiddD9CGBCjLP35"2F-$!GJ%U#9c3G33@qDL9B"PMbkd1pbP6)SmVdR%J9
+Hp5FUCR5'bLYFc%UKmSFa8DJH[5SA%j9fMbkrd3+Maq@QVVN#8KXX"'pJ+S*Lf+3
+)Z4,9Em84U(iKVf*a)Ip,UlimVH+8e[M+6UAULqN3YCiBB*MR&9B8+!U)NU(RfJa
+YGqC1Rjq6TP#p1qF#iarYEUIJKjQKHaNN(*6!TmTB3JT)iqlLlr"SIL6Da!&Bq,T
+ABqE*Z63AhaENi[+ImpJ[4Gjlf*1j&-92aD8JIPcUYDXSQ'Ff6SC)V8"FXDpKdrD
+-9(Z2I99p@RQemYKAP5Z89mDaVllU9Pk&D'Z21ZkN1RL,[R!$!UPrN6'[S3e9`k5
+m'!UcFf%,JmMQC1QiVE&MZV5JlEj[6!(SXQhY,0c,[4ZV'RXh9ZR[3[9[T5QE$b!
+dQ2)VmiX3iI"'&LiVF`+-F`3H$l"DpBbS49GCD0TNJ-J5Lc1&UYlPE4HNqYV"AUp
+l4AQG2pMVVfj5ARZ2H3d)G[1#mM*%l-DMc&LN9pi8L6j(`98BP@CALl622!X#SKa
+13LKRFMR)MR#5MJLI!EB$6%`3qS'2$f'5C9BjC9YLN!$H%jEYd'TiL3RS[4(88hL
+$lK+8cR)9A-Dlk!$h!91KBaK6IH16i8Nlb2@lX[98`pFI&aY)1%ZX!1%dBG*fBAT
+BV"9&dCec-0PPaMbkdBVXZj,$IaXU%HE+))3'I#@Y#L%a-p,I!@!`bKh+X+K)U0#
+d(6rQVqp"4@K[)6drpEGKUa,mf5PaAF0*0ZIC3F+lY$QkRJ2lTFf4$c'TqX-"*,9
+J$T%cIcMJXp1a9MUfe@Kh5lc`SC29!&#Y0FlhML2!YLr)5&DS1*&Q%Th-DSjhL"3
+&*i!FilmpF&ZBfRr&)9laUMJ!FbSYeXM!f,4@NTQ0NmRGKI(je,1#'6ULT"jHCXD
+km[rH4l'aSZMZp5)%-F`Iih1U4A+ZXR)K02G5V&SGa`H62p`1c9A'eUQ,HP(-&V3
+@0KKaH(&bEhdS[eh1fF#J9NIc`9JSAijE95HkB'@D'&lR)VBBbjXih1##YK#a*9B
+TdLVr&rm[mMri,hV-Id(P2`hr"I#IIP$@JK55*EM2X'b'mpA$q%233Sh#LL4B8"L
+daSEm$iF83kljKd-(0H3GR0TP3ri[,$SCZ6(FUL6TkP)iI,ZFVZ$*$f-,frlK%"k
+i1)aMjL+TGLR,jE6"Nlq0,9K$PPJX)iZ6cpHhYBH``-PGSDjhLSe'@J"aD4FMUSY
+[`j*ZSqT-5TJ*h`E"RJ!d9fieYC!!DY'NFKY3VDQ@[iDPaHS@Y)XK0ANabQQ#f,T
+BA88!,%b)!YVlaS$SKR)lQpdM0RBHm6LTFkfNcZ@LcZ@McR@C1TH8&d$Z'X(BraY
+[%lVYrr@I0mj6q&eA3kR4rpm[PA3c+iqmD9V`U(JNd9fmiT&(12Aq`Yf'f#@8YE6
+YUDfU*&H3!-RP-)aNp!hd@%kXKVQc%f(MBTQJ!M'TF1*UXh`$mCK8*hJ5BF@2593
+@2T-@m(!5eV5hb)rCJ50k,b3CJV##E(##NQq'qF9541*B2Ma*KdI9U#-ZAY'552(
+(HpIlNRB#CZ*il58&ETj$qY3kQ2)P-K&'-*HkP2VC`f9rqEdP6ZT5"BlCqKFZaf)
+bUL,aq)8m*L&hK#GclmVS)JT``i$(Uk6M!6jm&f%YN[Pib8c1PR1FS[jZASE!lTN
+q$[XUMf$+Yi+!d(EHCcEMM%4!'Bbpcf3[bqQJ2lc&S2%+&)VGL"2XX3`ZR#!q-9[
+K*VY5H&+FP'1h6R`mJ-2ri*24DML`r!(Nc'$b"T*Q"i&+mR'UM1i&UGXa'Acq2S!
+CQh(['B9&q#FQiK0M%UkG'`(q2ac(%9`8J$chE#-QGbS5P[Daf#0FS'hRLL+Na-X
+i`-+4Im#Ipl2f9"lK&61dj,6#cM$EJMqEBB%i,&IP-b%PY%i0Kk*,Ld*3brHZ*iI
+"p96JSe6JemKii1K((8c+[G6GC+591Km!#!!0lUbpq)mDPd!HI9PlElkifVB%JYi
+fJi-C!V`BII9ca+$H0qjp&q(iX*h"13"jB@-'(l4&"M*b1'5#$[&QlBjmFF4bX%1
+UKKa50I33@D*[4,kB[T(Lb*!!3qU'(&*hc#&Vp)h)'qNE+Bi11D4fb#'e3`j4Kqf
+$T"8[mR#pd[J3&SPRCY(#bHEGDhIF"ibC)F1%fmYl#%AF8Ia%931'Tm&!V%00Tr)
+jhA4BC$BKXSQpkch@QD@#h0+qpElchY0,XHTK1hiUqr1,PY3B'c"#k[GJ1L9`)Vd
+*dbKRGdrmfBFrU`%,lZ2d&c14XAeJh`jaQ!5`C3lUDKq-DMY-H4pZY[qBNf4`Vd5
+i@`rfB4R#jY8'ZQYXaHihHmme-4aS8j1T@kc!I2Nc%R$I#MA(#U5A3j8pc+ceMB0
+FP6%*kjhLcYjh(TrYlK5jJjCJ-bXfi1KT@EPIfISe"(p'FGjfc[FD,VkLN9rhkYf
+"$iFVAe6[%030`)#Y4((Vh8#"'k+T!D8c*)H$qjC3G"Te!J6AAfhQ6S!LEVe+#G2
+0$5-2"MXFZViP(3B5UALZ!J#[NjGPBDV[[(2+j9GlFERA*d1&d22hbG5[$hERL3R
+ZcKN*d1!QP-*r*cJ1(3"&q0R[JV3#YVAMa8PINJ#XNfqG4TVf0"*%AFCmBpI#0rJ
+P1YSB&Te!%66KaS[#1Z&Scb!j$#"X'ppHM,ckT6Xi-MZFPDpZ'Kl1bmBPC#3)HRI
+j9mBCjRHGcmj[Xmae`mch!'`i8CKbRFI0JF8+'4X&E+)f&`,2hqH0c@@cFX2!V,B
+B(!0%dS$,,NcS,rhZV24Y08)Sm(Ta5G$A!AC[bQcF[3Q%ZS3*03(ij3`Dm`1iHA&
+dSeT4#&b*(2k55%JJ53Iha%+!2Y6a"bMQ-)-IZ-`0l%"bJS'+b@,+rZk'VJ@E8X!
+eh2hJ%-8AU+&(@Q)[5ZRS@SDY6XYBGP"NeGYe1*D9pIIbe@9&mUele5@M`E(JC6N
+c9Pe&j08X$YTJa0@eq&2$!CCarT%5b3Tp`$Yqj,!dBD)Z%K$%$B-ZCc,3TjZfEX4
+PI10L-bq"HKq!k+BmXb!ZKJF'(bYIHUQkdQdD2rcMIA"AKXPaN!#$m#q*cZF539b
+X(+!!`kUY1HNTm!*f4AIpUG[dEZGP4JJ%J4GEKCYN9@VN!8aaLSA$j'&VNdKpSYT
+RUrG-"Tk4N`5L,Vr14JLXC+ak,jXfUPNZ3NR$"F$!DKqV,Q0L-KA*D`#%Y#fGk2`
+$LM2Eq2I1aXl(mQ$Yaq&##D2ff!PQL[Ji*%bjimCc[$NN"-H93&U%03iL)#0%1(a
+%4Ya%2#i5kEK5[*%)bJf%RqFmaF8IikHS1%NIZiUAmdI9c89HA39@m+G59YHTMbF
+q41R$51+$4KqQ%Kr#p+%Lm5&#(h*M!68$NfkT,P'0XB!lbL*AQc'0d$59B`EXGf)
+CUZf[,R0dQc!5Aa&5['8&"iMmidCJ5bH-c[AVqe)UbR3(&hl"G1I*P#d8lXjrf$%
+CC+D[V@05SQN"9($E5B#Nm9-06mfbQXe*Al-4jr5fNjR$(6pQ9jVY4pk!'ZdL0GT
+m@HV-"YaV`V`4MebhL6BNC5e%dFV+dC1NEIm0ZR+j#0'&8#(X-KEfP-aVEZX,L69
+0E!-NYR%5fe3D1pe,BZXMXGdPX4@6d"`NY,XN0*9%eUXk%X)kP4$63%*!+a1Lb5D
+%8S"3[)T3HK*#-40##3QK1+QE2@U$!hZQ%1K[hh!,MRhGRPD$LXLlFFYI(RmTeR[
+mQkCXHZ0)2BTKhQRaGrNQ8VIB'ACD(2-hq#6P@Q1M`m,G(JedY#Y5G'@eP+&c8Yi
+AZ"-*#!fUJGR&X+0MaDhE,e+J%kNZZ6fK3#k!+,j5ihU!)k`!r63QFX+P'`ijF&Y
+MPI0m*`23f1*BGFhTFlCcPTEU@UFPDSR9aQ+iUA0D3'lb1VRK,DP@8KRaJhArSF!
+dZ4#63aJV03S1l(##Vf-RH1pfCTF8a4G'Gf2KMT&``b6@'I8b(1@4@L#(GA*Di!U
+pG#Tc9B(J4Scc$1iN(NJ*4N4f+T!!AF94$`$#NMI&Dq83km%Zm[*qr5+Hq(I`QBV
+1rZZcX5T8(m33S#SAXCd"VCFYVJF%!!Q!m,F%"kDP9N`LapcPr%K*H)DrcH*)ZA6
+i&F`!#3X3dq5mf$"J+rjS0AT204@ZUY'LK`KQ'`6-1)K#8b-d-5NPk-bd-6cf*FP
+aE5N&(4ITGC%H,-9'&0M@J$*@dq%Tr)c*6,%&,%c4*0,$'pILdYY10Aaqa28!#N"
+UZk"5lR*ATKqVac8@91F+'lIFeaRQJSRdBhB@#541k!)-(R#fAiamdXdZ+(+EiI*
+R)QYmdIi,MPYSN!$NA08qr6-4q#2"KJpSl[-3`,&&1&Fp221fZ2KMI6"0AXaUB!4
+0)kl*98E5-i%()-$(9VVB4ApKjQfS["'BG6%q&ZMME6`b'QR"KfEk-)[L'H@%QSp
+0)m2,UfhF(@)MGrE,KkK"cd0p$rLP`BGPC1QTKPI2mZ9M)fcU[(R2')l0b*j6$BX
+fmFTl6IBBri3(N!"U`NrbefGP6MEM*bX4r2(a2q#Ej!ri"4j#"p-rfk822f&jeJq
+MpddN0TK`mBppkmlqb"U3!'efp"Ya*iPXVkDE#EVCPq'EjZq,"q,dm8#"EdSISBp
+,*A)92VE4!mAd!+[r%5,lfhP+E'ij2H#M"rD)KC%@`5,JK9H`[(46S*XDjD%2&@H
+M%IG0d8L+EXl5$H$qD*M%@LUBPXEf"6XCQbNJJMiB#&,+6Lbbq8h2!"L+eF`'ShM
+f'I(LI0Xj*N!'J22BJEB,Z,'IDYLrA5&'-V,2X$-FDpK"*Yl2-&&krmFA`"CrLm5
+lR)r$RcBFHBdG$4%ZV-AL(PVXKZN[`i@him,1`RbdRF%&"Si!$YKj%T@HP!!Q"0#
+!KmXT'E5(MLileA#iP-&Hp1)Z8Kh&A(8dR[#bdVSpbr![LS`GPrBCVL`l"p9N,5$
+%eq#!Y--G9e5NU(SV0kSbl1Jd+q!%mAj6aj%Q$L#8LKeekC)e3bip3)D$0,eRjCA
+)9BdA'+DdJ(**&&TLSA#"hPb%aFdjqEf"f$)ki,Fq$6FU8Ji!'@,,2,h+TLC))GJ
+"iU`idX4*b0KU*eFTrZ-QUP6m5U5NrR!pYXS2aRN5fi0(kT4(UX4(L&Y-6%8eQ,L
+8A,GIA"a6AM6L(dAA5L%j--TGkqQe)p5eP+kHJP!AZ(XqIAhN!@jZ$hEeTkr3TeR
+4dCqq#IEb@D%fRRjYj!%69&4+pB5*R2j@E9CB&DUF[mNRb1a18QK*8N3`9f`ra%S
+Sc6NV+jVAM1pZ*MGr*,SQLSaPlE2$6$)EZhbMSr(RZKVDTk-hfJZ",IFjR))#L)1
+B"Cl[j#$[ZbJ)fHRi3))FD0I5'M1BLT[d"$GBif3$@+F+Yp&JQCh,c'r[,M*@i0M
+AfjRB8a#4NChXY1kcLQCRa#5ab`T5e16SB4%0dF*T$Bj-SiL5[mlf(pbM$B66AY)
+'S)T6IrmPU6hbKM&IC$6LNRrr"Ji*$kBhVGE-S)0)R"*!%mpS5&`Tl%0XQ"Pf0+a
+Me6AV2qNE4VHVSS6,ib"I*MXbrI3-2e53!,l#c2b2d"K"4[!$B!`rkf43jA5MaPe
+FFUSc@C!!rRDIGA,qf%Y9Ff*dJNQJeAU-Jd#iBSb6r*aQGIBLi@3[q0fYMpM1)$R
+8Eq%%r@K`lep4`6f&iUi&!pTC#1bqcd"%0YjiHX(15F['dp-THUJ@$cfPcL)%$"l
+q%K@qfAMkGUQamA!p&cRI,TK'3$PD2RGVleq"&!iqRZ($CYN0U8CC3TqQ*m!mhN*
+6KaTDS[&P),5RI$*f#C0Dck`4f+d,PF'kZUL&@hpjNP%&F&E[CN1F*2F'GUFeB(R
+GiZb&5fFGQ34-VQ!b5Bkfdf+6!rLSK3qJTMAfY`"*rUim9NA&9BF+Tf*I0lJKL%M
+R9k8aEJ6MjpL4(f`Ha1p%8@H+!1GNB'`bLiic*R186UpK&apQ#ePB)!#9F$KVGNF
+1jHrqC#!`hMhq%a3jNh[6J550F0dLGl*+[9N33B#YB*-RrZ-bS26DJZLfbB+H"$j
+"Pr`D'aHcD+*KKmcTl0UTKYhA+@dZI5ScZ@#qHiajlYKHXr%FR)@Br,5#l!#5lVr
+!&6ebNVB2D"YG2UFDKVhAdYLa`!3UepXLF`MDDhY2UVSc9G,a"S-F#0PAmPCm"G9
+-('NqhmR(+KG1$9jiYT`B0YeCB!qEkaJ+%`@CZib#a)-C3a3QTqC[S5Mhd'HR`3j
+0+%jUF-cXFRLT4,-cQBA+EfD9RqiD"&$5UaF[03FSXdS'[VFSbABdhVR($L!h,P!
+M,B,kB'6B1#I8#[RX[)"JiH`8BX8eLJEa2LFj-GP*),X3XZbk'&@8D5'RLk8K6Xe
+!6(DI1qTB9#&6L&2eYR%cBD84a4id*fAPH*rGF%ieE0QTN!$ealR$(,Q!JN!L)C0
+AR93mCPYhikhE3Shr3KhRMcpX8VA&(rkQ'jZX8JUpP3V06!JmP4"11m50PiiQm8K
+MLda0bqSG3`+81N@0&'EZ,6)c2*TYR`PL-QDfI`pK-P$'X*j'B!FZM`19EHD%#!0
+N`m*a0Y,@cN'Vl#RN6BE`Sh"m%kR9hb'*AqA(4irim#JqP1#K)!49PjfR#eVd&!J
+jPCD5bM$C@F[I6Jh8i@6'lP89RrUD&p(-ARU0qrjHcb9&F)qV$RB'1iHZLZ*1RC'
+P8R8jcrHHArQT'FGPrPfB!a[$*lIB"$CBI)A&EZ@J1jkF1-L6-NGPK#TZ8DdcJ'A
+9Z*)!ZJmM330ZZ"r@qhYp"4LK5@b(h4eGY0""e)"-G&V&658ka$QTAM&qEXLBJ6,
+*ATCN@L[)i(-'U3q3!2e@N!$p9S1ERm'9[YJmmKF`qRSM$iD6JDe0DT)#b(VmfD5
+i$9QK3"Uap4j8p6eXVBFF#$4h&PY3mI%I85ME82MXUZE%`Hqc!U2ZT66R*mA9)a3
+A'&FIb-q-EV$+`!2Pj,3`&YZ%2r9kdKrXacqL#8XMKi6SH[DVTZ))1jU$b`4!LjV
+BH`![Ym0&G8qX(!kkZf*Pl+BE+m(,Pf-eB)H5#L-Q)e@'h@&T[$8lJ10IaTrpq,1
+,Kcci*CFZ'A,T4Eid+VLG5-[,cHK1eV(BHaXdhi3r#$-kX!'I-9NpFmH[HD`E0)p
+p11#i)jSZJ$eGpYePF&D5-+8Dcc$r0'+j*`1!1a+VB6FUS"0[38(`C'`EPJSR@PS
++f"1J@pRHF@jXUc*6@pi,d$0V([a"Z)LA`CLfdm@mbX9HpPJ2YU%C!C`Zie#&Qil
+b*5#qA#'Z0d',Xi!A"`2hf2Z6bdN*P4-6$+$bpfIed%%bHed(0E0F+#PeJ-c24-1
+'-Y%J%bV#Q9!i+Vr@,`4Qf"bXfTcY0k+*AjP[2cE8#M9N*6*M*&53!!%9C!J9&+X
+#3H%`UK,0HfSF*`[f$EHQjES2KbLLpET,PI'%E-f`m`U(1HZ*9+qKlV+T5(5AGP+
+1lF2[#UG#2&!['#88dr['P0*G9KbN1bbMlL#$hi"5b5TGSP'9`3qTd8h,C8NXd'S
+'hYQm621+Y%V&C34"LDlf8)ce3ZA&9K6bFDJh*3(D)aUb%Ra6)'KZP%#j9p3q1[S
+6#(5eHRFQ#0Ak#IkX9[fkQJbH8P4q&lS#50PdUHkD%Yafc#XfmGAL3$@K9S2-mRr
+LS5lKk)*S@Rl2"YRbPfGM,F,YN!!,5P'p2m($Um&kYFiF"a&VdBNB3Q!`8%KFA$I
+J`!kQ0irA[e#D!qb$ijcjL!hT@`d0&[CY'&KSK803U(&JfMi+f!D0"'S2YF6@Ff+
+J`6,B@$pfb#ppQVrIpc1`bA$,@FR&&@R)Hd,ZD%2HpaSRH@"m38T0(D#2B+eL"jl
+Ra1d"Q%'+Ym*T+r(j5!Z"!VDX5@SE+F3cdD`J1NX`m6Er04!E+IHGdCMYiQ6cP5"
+5c@&Zr-j06I8MR3bTlL-(5e4*Z&KZX6aUBkJA6&mHLd,r-4*Vmi9IDB9EKNeP0R8
+CR!"qJNVYj!D(F0FV9lFjThUR9VB5UIPj'UN453mQ0Z&A!R6!0S@FR-J`40m'0G!
+'Gre5G49Y2i$YahPcD$l8FLD+6Xm`K-erh&IJTJ)H1cjYiNpRSX6%rMDf4Nh4p#&
+-C55PU)@0#D8`Si2H8!108*aC8JXf8JZf8`frke2F@GI!X4d+NN$Y#k*MF$T4CYA
+6LRVBQ+BFa%9r`4H9Vj1#f#M8!`X&bX(')Er-JSR-CLfr1Bi+l&)8K+'EFErPK45
+&c2b1$bU"Z[K!(D@NKHM@HkJc$fAmbM!XKe8(D2KSkKbbNP1LDiBfREGD5A@BT$T
+5#YMh@B"p2J,l2LG#jjqk'F)%1@VJG+CRJ-,M!B,lAXN%9@G"8q!qhV!1q$N9TY)
++pUrGdF(J(N,A(3F(pb)qGT)YLYMD2H%NJG652JM1m9!a[*'2-3!3!hp)EMd"GYP
+P#(G(+kN92m(l&d9bAfjL9AAeAIQTiT+A8J"[1a0+$(,K*%J)V$iE`#55R0r--+(
+-F&1!PMr,`VUmXV$S6lk-'Gardl"`$!YIqE-Yr%UYXP"a0b8B1Jh!b"`F`0!%J''
+eTJ-BJ-+8TPidq-JSUC-f,N))fmi1QZ-[bA"X$`M$jBbI"pDi,$PNcJ6l1p3a",c
+(EdpN![dGSpTcABjZ"+mp5)EH9a+MdFEMXmfjJ+1,Aqrp+rh9XSlT6ic!i8jfeml
+10ajIN!$"kpc4'ip2bk#P`!S6L3!dN!#BB)8*05'$0eQGdZ",Tk$Jba9&KD&Le$J
+Tqh*ec2m%KK(,X"UQ3fZ9)dZ8!qZ8!qY`i!le%"4@15S9eipLpSJZ3USbqVVSZVT
+lq@i,91YfX)!@5TpS8(eJ'1EiSH!HbdSC[B-fZm(S!&U2"C3Q3cK8"$h+4T2qISq
+-VZ80BN[8S%cC8K@fY*IG4aX(&Tl$*!QbXI1BM5NU2+S3A+MPm0#Y4AE4eS+d04X
+e*J)$6-+V"'Qa3E4Qfr9#rU,-"IHq-d4mSIk1R&EHlHMDq`l%&cTm2`&93(bF8ZI
+AHpr4Ac9!I)A3&BdK$3**)-$))B**)-#)VFp[a'q'`6l[`,CFJimb,+C8DBG5[(&
+4LDN+mKK-S5UmU*@U%U@UV"jDb"A"k'NCmpraX@%Rd3IXkKKAGJl9fh!('jR"4Z+
+0Gl#445%+36l&S#CBB2AIBVFIA[6SrliS-rkq+G@DCSbR&m*N1+GR`ijZ)plB[E#
+AIq!B8-*!h-dNTemB,PF[mBG%K8,TjM+N3X+a-),UV%aXp6JhfD@YSXMN1k)ia&E
+eaEaKYee!miT,hD2Uih#5D(-(0PM!)'J`'fl!ZahTY6LRbY3+(L!X'fF`EXk#X#I
+k)cL8B4,%*)K*!"-0Nc!Q!8`qrK'lN!#K)38Q'aNSa&!YiP,P3d-dFPLh+LQU&*S
+,D'"UY*apE(lC,Fm%9$2FX)a9'2VTPXqjSTXq!GSc0[&J8,jiJ3%r'#bfRA6(0PJ
+'KfkbTX&*D$c3-0(!J*'4clMFj[GY9q!DB$,B93AQX@$Nehq(Q@@R#`PUIka5Kcr
+JARGC*"N+IR@4(8AP$S)L'B!mlH*K[9U9T$'j"lrDbB0XZ2FFX4PK2&c[6MeL!fN
+#qGV+MpcM!IT5(4""B(S&(%'EpB4Kp@Bqc'GR&3M63!L(&$8!9Jah9Cjq1cd1-93
+9(-GIP4I!f,hLMX`a@&rV(5p+rI`MGaB$mL%FmBlh)5(+0h!@a'XM+&iBh60j`i&
+Nl39ZL)%K[h$BqP%MPGDiSSi,Dk9SL$9a44ST,P!-qAF($@[@RQViSed-hXd&H&L
+S`qG3C4Hc#6Xl#dYJlj1qak%QNlk[NG+XFMi"JJmShBJ2@(jXF9M!TP@C$1d`+&2
+j$+FE)HM*H3a#pjj`rmN'aQf(,E49&iIJECf&r,0i@+B3rZ'ipAk''6cLjMY)H%i
+iF%'$2d'K)@fK$9C&0!9JTm`R9Q,MBmim$m'&iahkdEaCMpD2(pUfRDS`!GBQ*@$
+Ij1Dq"fP0&LYek"TG1!k'L"PXGM0"UJ#"X%5&!#4AVa*!XUq(#5fp'U2+0Z2P@['
+5SEP`@N2)`8'Z'&4+2aiheTYa9$!$pj4+,Ql$c&M8RNQqD+Yb0*,&eH2+C5mUPp9
+I)V&4R90H[MC*fdQm4%1%DP0j1B01"8&mVbpc03&d9Pab&lZjUfeNpbm6Ml95fMR
+%!N*hJ@Ja1'#Ge(l!5HN`!Bi*9e@4)%k[6++)I(d2dJUPVqp")N9md#+QK9c*XF4
+#VTD4Z1@+a(RlV6F+9j9YBaLeMBGF$`B,'QNT"Sh$D",+$'&+E5EBac@6IcS[V6-
+!F6MBK3Jq`qa,h`1pFB5jD!L6im@#Q66"62E#2"jRGH*R0FP+ECAbDUAEqAIH`VL
+ah*IkcB0A9N50ZD[M(b'"cUN&+CmdqSePc2BLS3Y@UqG*5M1(MIZCINipmb"#25p
+5iVK5*1RC&HE604M3%3bSE`D"5+ha(2rrCAB0qI52P5%I2r8E9bHP2J$NThIjGZC
+Y(&BP"MhNK@q0SpVD6)jB3E#9Qd[k-%5KNI3*S2P&YGG)#PA$(D5TFqSb*r1Nm4e
+fcI"lTq"LNB)D!3Z(6fK5)aS36D*aLlZ9*j`X)rG,T&[BS3&LZGl(U6'Zk'NNaX"
+i)j'['HIAIjj&Te3hKl4EN!!,6lJA'*pa2G!6Am)BLZ5cpb)IiXm0Yh`f(rRcQAF
+MDhq*B,F*`9,+Zj6%#dF%h"64i%heB1rp5%mra"embpfq"`F4HaQ,R8N4YRZXi2H
+FDJKIiNEG4`Rq%fVBrXRIH62M4ZTJ`Spd',dNr,8NmK-NF!c!DAf*"&iPZZ#A9bM
+#RMA1kd-eHVFE[Im%J8I@N!$!8@aIrPT#i(cVd`Aqj6!*[!DJHBdlrhGHEqrRaq%
+S%$jk3h!4Ch2XRB&l!B$3AMJ4p,#SURE5i+*Ph1"D-3`T$h%Bl-bM8eh496kDUL4
+-K*G([S%+`DbX"MNSP(Pllaf1[%FQJeX3Va3fNiqX-NbHb%0`YDB8%RhqB1CCCbq
+6AEK%V*T-JQ49BRR,j-ILaPhmFaYZ),,0ECa),NLB&5lfSeSf+pmS%Qmh)bhS@Q$
+BdJ29r`1RT'mr%-d+!92Zk"0'#**Q6*%49JN4r+Mqi%C)#NR!BXXpF@Fr%61(BA)
+cN!#0Rr0S43qTf9-0S9N3dK6B!!FRcelY0(S&JH''4$cijqBRBA6pkcr2L5TZ"-m
+'TeqS,qe#c!$KS(LKPjhN84eaSE9dS9F`Q'`PGeGF#"@0I!-AFKac)4XkG$mPY82
+'6GQ$SB4lqE+C&lJXJkQ5"QNKGcK+8)$B2k4#j35DB!##@9[&c0VJ!+1YL5'fQ)%
++V4C$fIT#a"VY%N25mJqkS"8LV50'LZ((1RG11(&NqYhA[Qp6K`G$HMa`$a[SaJ!
+$&0!cNfDBK`8V9DZ`8YF6E&608$EU5N40B@MLESr*E*fMJ`a"EHbBhDp2Tr-mU#X
+a68eJQZB8TUPNN!"03NFE[#Na"!2@S6",63PQUICJc")A4K%+3mX`Di4Z`-2FpJJ
+PMXmEQ-982Q[dHCd)a@0e8*'E!([!I0)kfmj8pk@chrSA!26G6-SmB6@&jTFTqTP
+33d@Fr'V"-!6bTK8#0!'Z#AM&3NFmJYG0@8eKSkS'f5JdrNc5S!T6a1bF*KDYqL!
+X@VAc2,X3JP'VpM46Jm8`h'qKQL)63VRVV"LkRT2B,pj'NKN`X4'$KPSfFX*K$80
+QYhZXUACNJ4p#5MMP5H%ii5)hkRUJ%!)8KGe*6K8SR&J9ETZj5kB9030*B1'MUeN
+0"4GS-0ZNTjL+%STphD`S5)r+j$TP8BV3SK5KRiT3ib,d$ca4-DFTV##85eY6)Fp
+"mc(-S$94B'N-SGc2$'(VN!!K#cJFiUk0!@P29Pc&&Yp"0m@fP%$VG0Z&60ieKF'
+%8qb-l2kM$a`VVlTM!&UKNYrmaH,9F3Dm1jm*[2QkrX%h3Q!8$l9LmQ$4"3YhaS`
+3Eclaf"b8LRpbrXd,r!P$L8IIM1(6$`T5U(Tk+)iQ#a$G6kXBA)2DBc88@jEhD-q
+%hRbpi63QJ6G[T"fJ$DD-G4FrraXBC$H-TD2imkF*9XhNJ4liJ@pM10IB1PcNaF*
+9%$PfjeN(4UIk0aLQeL)R+kD[A$Slmb`HZSJrPpfbr[-Bh*EF5#LjF!*TUBZa$`'
+kh*MK!4Xr#fIjP9!C&j!!ZVU-"0Gbcjae(J1fR2Ik!B@M3F,k-Ai-$)ePE3U*($5
+)qp@eaaGLkq(%fM*ppRC4E)f2)ASD'YQ$VXk$@DR1a'0QiV%32`DR",S3KKK+(1V
+C5BY"B-`,lNF&8d(Eh%B2cl(,ED`9Mfq$1M03,4#A#%aM6Sjrj!'lE)lSkPB-NkZ
+V@lbD%8-*Bm%*8ZBK*LHXB"0$"I0,Gq)P%Y[1cb3@pG',X#!d4beEUErq06[hD@N
+,ME5&iD-@4SFX6,ZJ,%PEQ$TfS6`dC'(+Q@J54kmh$APYTKel)HeBqe((AKUbd$j
+i,!rG[Rbpm4Pq%D8ZU(mb-[L3!"KmK-PC!5PSq(c1&f&3h'`mPBr!bF(PGl4[k*L
+ZhG!aUaR*p-&(H'"SX)E[%62-i%%cXBU0#%cba!+q+iUEKS*@i)6`iT@B-Qba'$k
+9S2RBBcb!E'6VE`66!4E(9$VpiY9R00(&H8"a*K3!(8*ABRLm(Q5JK)B2`9$``mX
+L@8%X*VB,%N)$mGk8jJJD2i)CU[,qFGqI#MF@lJb+!SA+R#L$bS65#9jlH`J,bKI
+NlBZ,SSXZ-ZZdlL4F6M'*P"1l*eieZl2%#-lb38RcEDmBaZf&MT+l"2ZjlNbI`SJ
+'V`dH*eHjA84BA@$h8X3F'fm2#Bb11[#%'%!8l")Ul1e(`(&kl4L'PHp(8diS,hD
+'jB-dXEAD&pcDR!L$eK&l6q#)bfYajfNV'J+9jH6#JqT(DcL`K@KZc169(!FQc%4
+AlY)V*#q)BT+[iDMB#PDFH*L(*iDL001$9Q&fEK00B5V*"EDbB+Sp4&65#-MQ$rS
+Hp,F6Z@Rhl8d2BYJ)LG(XGf+3!(LSDMm2!bmfp085JL(N,hRimiQ(RdarQ"Q8dN9
+bDFEP8edLf#biH1MhrjcqeH`c&G+Lr(-%!-%%59TjP9fQ)QF&qd#$H(-U06NU)%,
+mi`B8GP5GqZ+6bh*AMG$ETCPa)3CHkY%(A"UMm!D'Q6+&)I1"AT-(fF"`'e0'+0e
+i8jQ4"i864Fl[If5NlPUZ90Sk-RQiMQ[Z2Kj@qkl&eZ(-C`$lYTei0LqD+0'8rQN
+3QTSFPY,86N!d6kfBfQRDLUQ9TJDQV64eBQV30)1TNkBj6$-dc@+DSqNf6,-dAF4
+d'ddV-&fND4l6#TS1B*URk6LQ!c5G`R5FTLj-TfMDLkQ,TRfBpY*d"-jRhNb!QJ[
+*Ip8bJB'1C`HNL6pfr,(L6b[q'%CJ#(P1NKKpaEm5BR4q4Q(NVl04i"mVZ+#V'ef
+*9Pp+$'R%c85iZabBA+kE4j!!NdbT!YJ%-1Ak#aLr9T[q3LIVUbp0Ab'b[KCreM"
+Cjp$58icE0Yk3!$Z#iH'qq-eQhJ5r3[IZdKIrblGZrqVSaEjChP)e0rKV3rH1JZ5
+ZMBA)05"&!q)DD1T4krjiVFU%eMH(M`B5SGX1YX`G1rJb+2-J3[81T,L+R(RKb[q
+aQ`b8)C)fVk2BqI1rL$-)2UKJDqQaVK'##USYI)RUkfJ5p`ic&p905c3-CR8AAkk
+DNm(0rh'fqRTXK#lr'Vp'',q!3q[&S@[("+[)`q$$D6e")%M")'QZ%`UPf'kFNFj
+HT3&eh@JF!aSYpV(cCkA1B,SX4$bQeMX(3hb3!#-)Lj89Q-X,81S-S@VBc%JK-&@
+4jG&06QmpkEdR9#`8SX+54bV%F$qqU11@mTR9j%Z$Rj(H5"Up$S4%I)P"CR,&D8q
+F,TK+)h)(4+%icR)a99mLjNT@lf9AJU%TiU[@-6&NFe`-'i*%E[2KqaRleSl#29D
+AaN#1K`0V4LU&RC8a4!fPXmjbi1(SjNFDZUE,'VTQf4fjaqK@I8B[$r#cV-1h1+U
+jMHFXR"TdQaLbEXS)kN@PE,1553B+kBl8+!9e8Pbd!1EVfH05q`)ZJiDXh+!Pb3!
+8K6Np4KFAJd&ZcqPTKU[NY-TGmp+efH)d"FY!)4aSB5!I-PPFlaG3@`%-"&`N1UD
+e$4fha30ZHQ!S)ipr"Q45'@*FbbQ*m[(%%5Ba#BkYAm,)3Hr+fFCf1!$lMH$KcZ*
+VEHIdkLS(aF&DhC1c1YJB+LEcVp293'L"2[`l(`k#CYF*'N0U-%-93IRe6*i$H!V
+fA+2XPP5*a*I*JDFa$`JH)Q,)F1EHBrGN'(q3!*4j$-8'Cj!!X#G$EP*X@#B'GkV
+J-)f61qXf-kb6NBpKi(kB@SI[&#fD`+,N8BXBhZ9&Rk3YQX#LRL,cNBp!3NJ01ZT
+4'"[lEc&M%EYj93`BL3S(9P'BqHqLZS('%5,eEhiZIIJN-6LT,XMr(#V)%Pf3!0%
+E$"@3!#",&%''dJ8C[832(#2)k'XN5)"1d9NKb1K8iJKl3T!!R0"+kB*mYE2B2&D
+3!0&Q%Q4+"a'e$iB+8VZ4%'5*!X@)P&C03TMK9i8`cD1%DBFC0MRC"+B+cr(rC'S
+C!Rj650cf3$MQ6"irF4+8I3i'i"NG+UMr[25[[f*"9CDQ#FS13H%IkU*PcA`XPXB
+2XT6-iUYPD8ZEDDP'5kh+8[Y45d%1DHN(D8ZY[&3HSU8pbY,QJbbp68[GD8YlD'N
+6,@e9PPU208JX&GZG5e[DLU9hD@(T#brmRh6*cG9T#dZaX"4`HS[i*dB5aKc@MEP
+D0fBfS5I6M6PD4XCF-Y5Ba3!P"B,VM'"LQ%F"l@e9$@%1J(4kYPZqh3kfp1[B!JG
+")I()d-&(VLibk2GN*d%YSm`D2hPG#C0D`Ha'2Fd!K(J!UV#j$*U-S(83h$arQN'
+Br13T!VYDhBB)8M`XQ#!&(4SGCqfM)%DH*"DrN[ma,9N2H0I[1Mm@[mcKh,`5cTe
+(-rCEdlA,E[PHJb1#YZ'@cc8Dl1f'JJm8"AIAZba$1Nb4XrF(82!mC#)l+EM1jcD
+UmCPlFqeIZ-IZJmaXdT(Gdr[a8+GiD!l"Q1-#T4me-AJ+E@i0`TL`aq38de0a"!B
+$r%%243M3#G0,T+X`R&`&%`R2+(FY``8RBhZ#CGFrQHQIm$-P@2QR8LJ-6B&YUh3
+JJ3FC`mX3KFN!!TNjH5UN#%(+2bFa52NKJ#abc)-"Amr!FB8+fh+US6C$5qfmm*X
+$R!`4PkXGaI%0rlb6AUIdcrpF6Tml4&"1LbcdkC@d6c-iTRG)eAU(9'Z+3@JZBKV
+Z6#3(Nq)IBJ*8)q&XlerrhcK%S1&6HG&h+18@0Z*L+$1'Bp,JK5$"eYCQ2-5$[3)
+)(X1r+X%T1KbkIR4`3$CqX2LRYR2&2FrAmi!jdA2X[h,*h2+Q"F-L5j-rS(NaA"q
+4PK3Z5kP"B*crm50ZZ)+2ad$Q88X`*Q@abIrFbF&HXj88pacp'Pe4mMq(amhqBM%
+fNTHrcU%q!k%CC6'D*NQ[PVBeL&pDMcQ'KdP0LDi,D!!*-R)c-G&)"!f!#DkBJ$Q
+h)ph%M4p,"KX$T`r$"3!!)aY"4%05!`"AiJp9$@C%!K!KiZj8lm&*6VcD+lQB+m2
+S*cN[&i)F6DhM8UU!aT`R2DjJ+H1km46Z6ScmrKD3!&,(cC`",@2GVKShihBb@6H
+E54-E$','d&[V@Z0N(%2YDDcM@*YK(1V39!de"b@Lm2IrIZrhhAI!iCRdf@HIHAi
+!(@Bq*"%3,a!!%"!!%&%[PBQrD'V#(r'M9bL3!0*K&3jFPbcXNEc'ej5X-@8h[KC
+*$(V54"f)TX`aXq@6j5q9@AX"R,-M4Cr0RaJ4lDC09S35'aG(%NGk`!*"@Z"R&cT
+X(PMCZ'ZJ6!5Rl""PVqP["PBf,DD"fkE'cFL8cVKSklipKL*LVqiNKAhiY!,6TN-
+)KeT&apFM&#cU019qpKU3!!NJh`$#EMV4GLj5p-8N(QLrAAPqdUAV`SmaEJS9[C0
+Q0T[Ua(PdF"P0QMec$)&E&$Y#cfD12AIeR66@U82TT&FkH5+*5#NkpD#6B@"H@p$
+NrNB6HhUMl1PfpHRFGp)kAK'GT!cVlAI5)SPpEh-4k-,3HjJbJb[U2Ia-al,&fJr
+($!9GTq2R4#6aB*le6AaLiTm&k3-r81+LGP`#SV4a-`EfB1*46'cM%rIJChFNdEk
+$2ZJ5HPEl86G#`Gdj`K0C+RASA-QR*UC@XbZ6kRclqjZD'$V%&R4j'PZJQeE'&MM
+3b@PXJ@0k$l)&EH*9YU$Y84(dJIKPX(LXXH"N[h$&)hbaK"5XQh#UT@2k+$jSf$f
+Q#qk('U`he'2E)dY2MA8!19j8H6jTU"Krc&eT-q*YDE6G-LLl,V622$28M!+0K"C
+c![b*QE)R*YaMdY%i!q@c"EEeqeAXb-5Z2f!)X25h,qcIjeZ#,ALC'%'5&k8NCr6
+e4H[5SdR*U)X@,IT@5M6e%qGDL-j,f@PR$qCND"Rb5NY,56kE(&dNpRi"$r9HXIC
++3@EG5HX`MVA(d')Fekk!#Ef%a&!!c1Qc$[2&GK`b'%)9Q'@RJ5qfC)jT)F-CiaP
+R+-iaSB6LL2f`f5f4K0MN"V[5P*J(l&m8kc)+IZ'mM5jFk8M["QZ[K"2PQ-P0JAD
+JBQl1i#+L-$J#aKAmbT3Mr0K`4(4V)D#'%@+bd`&5NP0cXR9DHPBf2JqN*fHPpQR
+CfM%YpfcGQC5F%e&48bPmi'#@,LIp6$3e05Y9'BTQkj)[+Q15ULMSUi4jC@SE0F,
+jS&h4"5HI0cY)KE&K+ebeT"ch@"@UDP8Z-5a"CE"B@!M``)h6N84"YPBShF)GHAA
+m-J*!GRc%MDDj9i@&&",h5XpeI*hq*c8T,'Vc%!JA"`HH4,KmGk9`J%bH$RF'C5T
+P5,qK"9Yc,+dd8LM)3mH`$J2Y!2)N30B9L)R$1N5JP'IG"(A$J)Fr2bSG,'E3aV9
+D8qi[&LV$TU3M!TpEL@(L)h)@URRJq%b!TYah2X8%V`&UJa#SUJELSLPh6LNq$N5
++jUaPLLJ1hAk(9k0QX-il*dbj-4-qEZ++L0,PMq"`NMUKmbcHm3'`f3Ef9)G0aeR
+8%Bqqe03dcdd2NkYiB(PJFAI,Le#FX1#2!aPq5@8"K3'#e-h38M1VR5,K9B26HJ,
+)T-CEqFK5B[[Bff$l3Xlf&8!d5fc[keABAZTqVCN#PCG@NMX8cSJJQ(r8b+k54-K
+mLJQ&2553!'84ke03GPP)3*!!1r6Mhhh"h+@&iN)dSf,K3UiIecaFb$he#lQePkk
+3!$)N([U(KmfG9N[(ecR,e#dJS$P%ciRCk,`k2YVa2KYBM`mkeN&L!4-AmPLU`L6
+8@3XT,S[,Ce-JGT,3p[@G68U+CQGS59NT@YD"C#h,V+@HcGC&r4CCc$U6C6l$CbN
+LQq46XSZ%YjYF-PmV[TE4KD8(TJZU3$Fe5YP*94dbSK%"8)F-B-QBN`-FKjUj-@3
+Z$fL6`B!%d*5-jH$X@Je`9U"Q,!R+Tj4"jZ!#BSYHZ,PTm%0$#`rjd1)"IYe@D@%
+8'jXcac+k0Y4ZE)l1Jk*T'!948flJZdka-h'aJcJfFh"qRaj$1,XHP8Y!6Z0D(0'
+dm5KJ*-&2'rdr!C!!#D*!FFZ-F0B2FS@#BCfXhhD(UfLGNrAE3UU+H2GVY3313DL
+eMYL*3!&J5M51M$S8G91'A1k8PPa-GV1*pe!ihqe@-k0YP$qe`jNCEIh9RVSAD*i
+55XC!L'Cba-[Ek-$#&j3$6D0*"CCA&'!*dXf$DDZYAI`53@a2iUD#6"9JFK&43@H
+SQ6VSfX%'AM$"&4X!5N4"Vh6!lU%9pklG*8*8ZQVC4p3Y8dK6T#A2IJ0BiRAR44F
+j5aK[+YAllI'Q8L)eG1hFT+*Hm6Im&-$LKhci5PL`IA!["aZZGV"AUQeeZ1C@FI4
+m*q+L`X`h%@i*+38-@cC1M5BG2*XHV3NjRM6SU2m"ZEJm-8)#i14P9UAp*Qb9YX[
+2+Qf9Ae@D#q+i"Z!0"MiRY``XAlDDUVFA6F*,3(!4`[B1P,KNL`[+BP#)%#e3X0$
+B4bIlL,#2FICKB"pkQ2U-0C@BkLc)[LpHBdp094ZBS'S&V,3'c,@E$Jj`HBL,+)`
+#b[1arA1dN!!+"V(c$(bH)JCN*$4e(#35LC-m$*Jc&XL0jQDPrN6,bGB'8P1Lf6R
+TcUJ1L-+qHNCVCQP08PQTmMY)K6!mmi,3-q$jDIM3XimTpM&"(adkUK4rRdr%!99
+qp4))Qf&dTPBL*d65mAaAEPH50pq9G3(Efq98N!$2U#JS0NfQS(91"INkE488dr$
+X9KJ3DVVaT12Eq-AET)Xhb5kfm)Y,-''3!&eFJTp+QH)EC4HMifFlk1,ma8,,%Z*
+QG6@%!-UcXY0mAri''+(#1N6C$R8Ce%rpk0#DHi`"0XXBB#1V,K1I+3`3ii9%jd%
+fb3j#(3FP"J%$h%!P9dFUc@&PSZcSMlA,"l252p$#N!$q0KQX6)[@jD3N8bdSQe[
+e92pB,LFl*eRXPFNDlmZFc4k!hkH*p$G))3'2p6PaNKKUp*Kl$-Ccac"`$-A(qe$
+3TU1qlZH%pPG,-+MKT`m&@MH+Xjf4T5-#@G`(%bU4Y,pll6GhS*!!m3d4i55MhP6
+Ae%5'6Bdl)8`HqU$3a*dlV'"+`k[4YEeM"Md@56bAQ6Q'LQ(hYKQA`850@f4-Y*B
+bVa&-ppAC8ZBeJMNEBc,QA12-20k4+S1YdX@hYh*#e5JYTdU0`M[5*%+e'-c6JZ-
+cY!q%rQ[0GM&CDkk)(f,G%NB"XN#d6a`4hKYUYhYfDD,M%b"rpP&`F926j#e-,2c
+,3de#QMSk(BH@(ME`KdA6"$XB+61K[APU6$A&mV80@@jd[@NrhR[&mk@CAh"mEIL
+Ti$1V(r6qSIf21[pbk`*Y8IH,KVR'pr82M6ihGA[%1['V4hjqjrFRrqc)IqVlEIq
+hMqdI(1MBGqL6#qqD,S@ZpR`R-ZEqj[MNZ@rPr5Mccmrr[e2rppNcmE1Adc1LCYh
+&R--I(-c0cNVklkNTb3I5IPchNa0rFI5r[Ih(VVZ[eMEIZrRpPMqjpG2Vrq@(rq2
+DdZR2crLI$rccY2rkJhrpm1rHqrrcrmqRrr[MIhcYkkqmYIJEEa3YHDGiBF'XPrp
+Kiq[jhdhmKfhIfrbI0reQedHlrrka[pRaepXIV[cGUPm%PUeiBGh20[cYfRpEmmX
+p[hlmRdVrjIjIYAjZjlqAIIRTVkaI[[,4LUpZq5a@A[M&NTIQ0FbHdpJNb8&@'QU
+`!pPDaJ&H`,B*0qbGVChQ1D05B084'K9h`0!h11K)Y,rY(NX6j+Mf#9i-5PJ6#QZ
+5Q'p*e4m@KUNESA[%YLLqVQfhe!P[jq60"5#A'+XMh$5q'*A4U"M[1BbE,S6ZRKS
+cHlM6"N)c8H!H'`&5Hj1M3k'lCXIYGcQJLe'(A`fkaa!L[C%2!mmdAcal["E'6kj
+Fm`R4MSHd'j2hB'b5GaS2GVM(M26JN!$X`Ah1"bF#)'RiYHE&D5*ddbbDTTb!lD[
+cf3,+'0NYNI"+Q,TK2NalMML,+`f"51)2#$bYL%[KPSC@U,32`#1SK"`jX8G&qRE
+U6L)q5X8f$`)**j%&*c'F$mCI5`X)H6ZkGXSQ1j!!98$44%1AH`c6qM$3KfN[BeS
+PZYYT`!Pb[+,QB$X0@Q`(8im(lKTKKZ5`T!i8hbAAMRNeC8*U#KR8*KhIb#ZXMEc
+#D[K8"Q`@%l"TU)`NPPq6J%e$*AlHN!!"Qm91B--lHMQ`34&9$I3j)N[IAGR3qZj
+A,(Ep994'QE,$H50,*edrfR4)2$-SlR!6C1I%B'3T3PGN+L-IaK3p"B8XXN&X%Fm
+DE#m1S6#KQd(X$F3iMVFTNRKd1Rd3@i`Nf+&Tq%-+!Dqq6pR+,X$M8+0QUdDMi*P
+H&$2c3-#)MY3eAeDYEZ2UfKC*V,r-e,802ar,UY8G-R@KieHHjZVLl2$3+BDJc(k
+-,BKG9V!&f-dlNbh!LJm'+B`1GZ8QApPCbGTCY8V8&,!4c8#--M9k0RG[`'2Iq$i
+Yr@)drB18!lPDENj+lYRNp)Zr*6Sr#G9ZaYRNXeT1LXBUEcp)1"$+DaMTrHpK5Hm
+b2dR[Q&qNph`!`%VVN!#4L[JmN!"142L9#b!K#iJ8lQlKT2Bqi@$NXce8kaic%iQ
+fUJCTK'VckIG-Z3dYM25$FIqAYV*-A'G,qMeYT%`%!4D6b#j'GS13!1"N9kAXmYd
++qIGdKicm#mJBC)mYqIIPlC5i3#'lFHJJ$kqBAV`)5f%2,53Mi424e#`Y+a@NQ1j
+XFNjD9,Ym`'b1TR+ULLLP$Vk1CPc+4RC1FSk3!-GZUmc35f2bh+e"K09cGepI2D1
+R3rEV+G--,4!-bZS@LEJrrLNMlR[V)qkj16!RlP&411khS%S)ER4G(ZiqM+($80E
+3Tb0c$j2Dp%"4Tf[09J'8R3I2%%CQJZiJ38pUiL,Zd9RqGV%)+N%Gjb&$'$B2Fi1
+rQl3JpeK58c`iL38pK`V,ih")*Y,b)hCU,%MMU"1b5cTNPf3J!9)`8CYKe)DZhE0
+51-h$LrJf4p5,"c#&MXK$EAb$U9VahDMPdj(i6&5J[Gh(KpG1ZXccZJH`"FmrSr[
+D@RUXFB0Qb364CA'DIqF@#dP8Llm86P5,CrSRUXAYISRUM[T%eIl)`2)9TLFMUMY
+MYU*k2*Q*d`CE8Geje'p4I8`4eCh6`SKUUDfSlY6NSLSA8@`NH2UL1XBKEcfbq[N
+39[RY6QQ9$jqQZ+i`94IAVP[qL5[%dF'&Y9QRebcADUh%kRCEGSIJ1T!!e)L,Vcc
+)bSr"QDGT#DNB5@FXcJUm(T'eFh&l&8G4K"31)4,DQJFMjY6cJk9VI&S2GmaiE)p
+'4&[m#,NSH5F%C1+MhBGja[XKN[+03(L-6!ar(PB-lrJTKS0qL@%&a,#%%RmB@H$
+B@&XR$&FlB,BGDYDGebb`-!9&M8"[5C)2)Gi5)RJJ5%@a9PkBkb@$NIXYVl[LAG)
+R18ki1"6&(ZGG,+p,*Z!Ppeh1Dm`**"UE,5bCYmDE2Fhd41je6UD"l)ACpe9b5RQ
+mFRI#)UM6BP%cP,X6$(U,4@XVEB(TZqI5Er4YXjVEQJRFkLGk,!ZE&afb@23,e#P
+)eUCREJPb#aQQ,"CXX9[Vb@aar1(5TZkfKAIElY*dZV*lSP2-FKR%C,2jrN-GG*(
+qM)cG',Mk3M%G`h54L2rBda!"4Q63*m`F$!biF0([d%[K[aS1V3[8hD"13X!QL!+
+E9mFCGIMTc$%NA3Va4a*$5b6"qN)U%kckA@#0eL%+*5-EQU5$2[8KUM1I8TfKJZQ
+P"!05e@48945#)1JkmFH"S,S0@(k+QrT3FL3CUrB`9[hcX+akhNp@0I[$UJfDVI*
+RhT%T[f*Jq3Z$L[*I'24Eq6h8hD"18T8rNaFX'"#4Cd&[RT3&AkUS+JZ%8e%m)e4
+&VTBc%3AcH4KI@K4b9`A[1,a5eP'@%F-EC"Q3!-Sbi)r$CS$,c`bilPF'e$P9aad
+4B2JAGKPDjR*hV4E+((0ZAeA`9UQ6T$6"PACUV(k9932H(KR`CNUSeX94(EccBi%
+9eJAhILcU*"h,hPc9X4E8I2K*(%eb@kmE$1qfjS3K"m+Bi"RPa#'Q65(TYai"LhZ
+SJ'5K%$f)8h*9kRUID6iLaQXhhSZ@kSFdLc2T$fH4DBa&rM%XLlcQ*iX8q-8L1f5
+C`4bdXI2BH!%jFYhKXU+!C894l0cH')36ZNXAj3L,X+$BEp'1kpV'PbTJ$`BVMC+
+Jq"4(mhfiHBFNjJ!iR"FT+MIbC,%0j23UEqF"&imZ+8f!)#b8"UAYP6mb$J@E,b!
+ieF(Gli3--Z4-G3KN)a*C&T@hK3541EUC6VFGABe(lh-6TL'G4jN8Qhf+'5[a!fP
+Dk05BFB&-19@BZT3ImFI84G#4TTb-jH#-CFTp(8'&mTY'lX!XC`BZj5FfZYaM'9l
+*M+!mQ3eR'j!!%"RNpM%!X*QbS$KrX2`LZ[Ab#CIjK)6SVRN"N8AN426BC8Fj8Xp
+4mZJ)8CM9D%2M,UXdk'BZA&U%$#BbRS#V9b2hE[NK-T,"BBDj+CNL&Yb3!%`#THA
+($#fCYNBY-!QKbPp$C[0,m[3#BJAhI[T*-UhKcr!Ykc5qa5SH'5GcJ1f8K9S2+J8
+%MGD-dT*IFee@,AKBe[3iNi`5kdX-D@3#8Rk+ZqIej'LA"VU(TP2QF-GhqAZCNPP
+%3QcJC1D8Fe+'CY1PU(`DZA$l"HmqN`iKCbY5[Tk"&`S*`m!%i$%HiFGqEqR$Q[f
+qUl5&rPrI%QKTG4Q*G&Z0ihV84iJddh2$akY,YeHIX230!VGbT9Xj@#6(#X6@XE!
+5a1qec*E-2ePBD5l8,ZR29$F#eM2!Kq-&!ID%,mDh9@`8#6JB,[G58EJBCPXCc-$
+!YiFAceUG"JDqRA)$Jr,&e26(LRY)($Ll!!UlR#FTE'PP[C[9%!k`I+k&JJ(,0ZR
+YfL&6dLQ3!*N8&23p4TGb-0bVIhkm0[-k!'lK,h'BZ2"&EQ0+8`c"EMZC"X2CAc%
+eV28JL80-ElrIA(UGrPprI@e,Dh-)TX(QYU1qE5#)-lVfh0aimr)mQ2KdmB0p6!e
+V-)GpN!#+2pUlTU3HBAd6aI8#p3")CU(Gq+C,2jKN6lL`[+PC!V9dk%A2H`3*8+$
+CZ6aRXmbc@@ED,-rE,%rC,*q9,Gfe'kp(VmGRbTrPeFp+&0mXqE8C"Je+*$*I8L3
+TN6E5,da*GKL$cbRMeFVh3@!0@prN'jr13q1m-'#iUB6Gdk,FQ""Z2*K3*Y[D!M`
+48`#VKi-"*e0f[DL")HFj'C*AR*YCaIP`f)UcdXq+FkeI&@GCG9,KCre9N`THP95
+JSJ`QGD-SXj9!@VTh`50NVLPcQ`"JR4U,PXN,9,,0YV,0IMAXCVIiZGP'[cCESKM
+l)CQZ*aAZL0#VkHhBmVP!FDFBCd@`hPm*Red8[aVG@Bh%Nm"QSMaYB2QD"!L(aGb
+8di%IHhJ5JhIPa&jj4P8NKLPhBDqNMS82KP2(3UprkPKSm%FGXldb-K)9D8@b3Nk
+D,PS`8'iB@2j,Ye58X6KSi@jK5hZp"CSMe'QZfKQIGUR`3YI&CNZ%9[R'UJX[6U,
+AiR%bdJ+e'&,K8Kq@`RG$YXH1l3c9FN!fc-)PdV5M8U8N8rF%8rHh`kVlQ*rU$[Q
+PlNak'+Ujj3``SJS(34@,1lG!!DcbEG+KaEPkeAb(,M'dF#)Ja+FNhM5V5b50@H'
+Y@XA598M`F*K2IMYcE,r!!TAYPT+*"5V#c"!`Gp[51+&@jidV&6)#5$Vq,55a&@b
+"BL5-$p!)"SViiY-49*&SqJ5ZGK#E@pDGA("Z6)F`Cq0+@CMc['*+X!aNrTaTqiH
+B-3'FS5pkZ6NFK6V2fCS6,+0N29[hMc61N`lEYCd([mMNY&FK20,2CT0(+JZ'TTS
+jjb!2E9l!"dc!-(BD3Fc[R%fh$@T##BqIVK+JJ#eSUSF[V2hlmCrd"iMe*aG`YC6
++e*+[U#A`SBeDN!#%[lY09FY'@l8%Z!%3*@4KDLq8e-k[Ilc'p3JC"ikTejG`JiM
+%SSr9keq@ABr1[pM&P&iS+Id'N65*1FAe+$dGmG[ND$@e5k0242(KXr5*Adk'#l*
+-a3BY*hN!-9N4#%XH#348ZZEN!MDN$qh,j#a0aYbUHRX8Tm#U8N@p2#L*K"(D"9@
+p%9[(`+S-8LqV6Mc9&AS`+i@f5hl3DMXRe"2Fq(TPidM'k8#`G&4iVZ%J4N(0Hac
+NbA&"2-l15P08-G6$331jbRQ4CdXTQ-cYfGIdEe`CkfA+F#Y1M0qY8j9"ESb9NF5
+#2P8CKf`G'Er,*'933(FC$N)ILN+3!-mC%LAQe!%0IVj8`)13!$#Ejf()Sj*#P'f
+hj9AEpNj*Y'`f2+jXZ,+eqSDhKX*YZ2+LI-2FeD#b`)p6Fb"+dTkP$I1K*lEK,@T
+PNr#jZ9(k"FkJp4KR9RE+(&X`9PRj)A-q(E0Pi)FrjTZ3!"T+mXK0mf`jGZrQHG@
+2bb[V2&CCTiHYV$2mV+b6r+UXkj5JMlC%UTTV9--c`j2)'QmqU[KD(Sa+C!4(#kV
+dB@)L9Vf[PNp!XejYbX!%QITXiXqlC"FF0HA1MT1E3VUXk9Nh1ci'VK-5*P5j#p&
+dAG-K'HT$D4S#`EN,Ab%(N3cj"N1fBB('*jSm#K+UQ'#UD(&ZQep6jk1`FTY#$)Y
+0!m[h6,'N%X(k5@$U`)+`Mqf&"0l'-[U[`fEdGMmcHS0I'6h0KVchmQ422(N'L)S
+!MMkG"A1pYNP"UQe`ZV,"0j[hXX(lE)12KYeJKCmER1hA"Pp4$dX'TRBbbmB(JRc
+-DGNQ'fk$fd%#$*dSpTIa*'N5bU+LMJ#e5SDbUkKc3,dX3cP89"*32q"X*U%d&A8
+G+*F-0DLL`+U0CSRK1-UPST!!L,5aKiZB$`fcPM,hI#YcY*64"a3`[jkX3QXe+TP
+-er5T5hTZ5Ph5XEDU5cUq3eh50Y[8*G3a*kBZSEBj1hN`MJLM2B`)RkMA5ED&ZB4
+(4CRCJLUr9AAjH-RPib(R@1pPi601r,DY+p+!*,JD@M2)&*I&8I'!+"D9BLG5mkj
+1DN+$PU8)""fD5ddaSY&9IUA`hH'*`lD6!Dp2cj&Y+Y,,N8XidT2NBeHdSCVVG"l
+LR)X3h!#i$+JMXZ-j8DZ!1ZG%ZCfSPi&+FU*5(B'l+R)DN!$AC8K044i&kK8CDP"
+&A3CUYa2943T5RUYHH4e6+UqrMmX-jfA'bF*Y@hRYTX$39LPcP'SVj5HjPl-1KV(
+`rXkj#pr*bSJHl1[64Id`p(B'AMN3e$KKk8(3UT@bAKY#iV4485S2Q")EKm$@cmU
+V%'B@`$1p0Fhh$$9*A!B$J9,Z`[DCZq$8Eidlq,,0E0H'!Li3&+dEZ0(0R1[1VRK
+qKp40YkN$6!%cK&CE!b0'$J&KTUTXX5K9QPHd#H[Q&YJPJ&E`6$L!9V$D2i"@d1d
+A30Y8)fQZRa8b+R,()Zk@1jfTUN(Am+3VeIF[EmdGN!"#2M"J(YBXNmd`UZL8Q@-
+J8"'ShH#58##V@ZI#J%LZ@TRU4TMUIKY@GIeqUXlNPqV+H+)J[QP8@AX8*bAq"+N
+KA6*[SB3mD0l1mlN@Uf#*0a6$T$8eL&`)cLi4*Z&1h&E!IY1L*0a4`4a8jA52eM!
+51Jm,TE(8M'JU%c2EJG-a$0SUECBC"NfMV-kX`X9(MAcfk!&F(+KF2($bfE[*XHU
+E[)ZXpR5AS6M#&qDBdf&'i4cY)H%*[#8F,f+D"PF0UA'J!J(XKi4Mf69#&lmPJZN
+M(@q"Y%H(lSI8DpZeTp!FCS[4a5rj9hk&p-K1TdZ0KlSmSGTFAJeZI%9BFP@"P$(
+91FC8Cm-be@8rQ5VE(kDDBj*#@VrZGBDdkR-prlUhUS#bkMj2G-e$jaiL*X-jcJR
+0M,YDUb+e1(P69,k1%3hN4YSK2ekiKG2jU9EV0(NAUpD,bPG9DIT53XB@9+KM"pM
+TTNDF5eLKNBE@U0QPQ'88P6HU634`3Sf'TC!!3Q%IDpUE&L2Z-ED%q91KRJUH%SU
+HB8Y#@EJcf+XcFDFc$A8L!ae1`H-*,FSBdV'ALcV0q@VL"'crP*SabR%9&E0M2LX
+lFUE0NFGP6jAB2$9BimJp94cj`PiZXMhb,YQ4ej0c@h&Gm+3Ej1"GcbqTN!#-aXU
+T%IAeK#LmSeiHBiJ5D9(Bb`iXa')fe+fj&ki!`$r"%V(0CP2S@+[Ce0RUe+"ZLJd
+S%c[$G[DBer(%"e,Mk$&bJlBp*MY-KR3BmeBfX,V'36e)E(*HhQ5(SSE3md35XfX
+94F4NLUL3!#QL3VBYfb0kGG4XfQae#cc4Y1N$#S8@(UlChEbLihR$eFaEFd0`ZGf
+Ulf$mfD16C+iR(H&9"+)UR%Ql4@D0C2CaaI8U*GTQckI"E!$9fe`hJ4GHj%%SZc"
+Tr(Qq)-'Q"Kiej4!(N4E`mqhdSqCNKHTJ0ZAq1Lie`&#BEcT),Q[*!9"BB!aPr[4
+p024Kr#P9TH6f,Rb$+hk2P#'&Va&VNpN`Q4Ic$[0jKl9-[DmK8FY@Y[L"iT3[R-'
+'IXM-3C6-D+%%lqC!R"F&jUbh5H`Y'4#(C2p-3U150GM!+9l`Tfc*GcDI)(K33E[
++YV2CQF(D95NXB$a6,lKPaLE8a!92kXmCQKSJS5'@5DAB@T`bdZTJ@EKE0N&L+iH
+1A*)10LJai48T(&piH(*kM3PHFm$f#IN48IfGB"ATpm0@T#eq9U3cr+T)NeK&QVD
+ALM60[iTd9p[!mXH(+FNbL0@m-0ATU0)*a&'H-rRb4ee9'8dhV9%5%2!Q-#ambT4
+481*J*!-qUPa'aLeCf5GmAblL4180'8QC4mX0VRS)bj!!3PLqrNSB`M,6PV"mI8)
+K,1QIG%$L1jDN)&`Lh3YR8j+I6%*GU6&!fRBD*GHBkLMZ9ciXl-212McX`m%qJZc
+$bcikhE@H@Qj`[$'0Qlc#M++5b-9[ZRMclIEL*G6dXLM!"$eF5%MZ5P2(Lce#(I,
+9''UV-648BmK5BqK'MD'Z'N0[+N-`[N$cEe(4G$%HV(NiZ2Pam1K1$%adA%[c8G2
+!SU4T28c)*UL6p[2qfB(LrYR[SqP[[6*iTepJ8$cNkVHJF-S(Z`pT[qUh"%LaKaD
+jqZfM#Z)6)1`"8[3R3(LQ&-3&)$`"8[`&)"`M#Z*G)"`"bSKhJ3M#6'B#VJe#JA@
+!$!BSFbi"kHA)%SBX!G)ES!`MC#IIp[TF0%FEhmSlaPM('$Vb,I'18!$,eM8X@kH
+F5Y+6QLCJNTrA2H%4,pCfmS(aiKj&EHX`N!#RNI%41Ta!8hIm#MF-+LNaD3F5NhC
+,L80Mdj8%Tq8VR%P'Bf6%-N`2DMI'lq%K`e2&4j!!6S'Z08lJF-hjp%`a*CTANT9
+b-$HIJEQLX'"ZLCpJ,Z%AQ,YQ#kDqG`SJD*FIB'TA66#e1AkkB'VccEf$UB",$UB
+#VUV"e+`frm"8`Dh6!e16"l0qr'6!9%2VraS`eG$k(cHBDQJp26$982DR!8`eP*d
+HQ%*bk!T5K&&LNiRhNr$[`9MBTjdR@+42$drD4jm1i@#I3Cl!N!!q[F,,2MY&jlY
+IJAJT6hc-'1F4bJCUY)'5HZ[4K%0$K49JMMFI9S4rG`F$6P")`#+kLMHDCZ%G!ND
+3!)1XFf#8$#,C42f3!2%'`*U$b%[cic6P+#@-KRR%SpR5dc"V0E(Nq!4#+HRmHJ)
+%&G0`*6+!2E'GAmXI!+$Z'Vq*!aZS@3Re5-%S+e$bkieDPl1j#!C)(f1!p)@`J(5
+GRi#de#p!QPr6*'eCem$bIdSfY2aHDVBZV$%DGC*!D+#NbJ!+)mePcCDY0Sjc)h)
+d&-FEQj)eA&Di4fViEGP+iE%PTU9Vd&`F1fM"YJ9+NK*j8h&,E0f(["%p*3QF4hG
+#D6S5CV6YV1Q[@Pimj!e5lE9i@'IEm*GHd%E)L06+cC8,p!XN-c*f*0Cm&@qHN`T
+#P[$0e`&#(cLB6'R50GBBTDceb5I@D&6"HXC@,i9PUhRqXG@XVUVC+R4leS0Q"cT
+59YiRa+`(-mFBX`8!)KrFGfKIcLII'rMC`%F$haVF02#eI4m1TJeqIr$eI4X'l`e
+Q$5CeA"cmZi(4I4phT(4m2("5X2m!N!-V'd&%3e)$!'Ql%&8,C*N!@@f6lpCZP&U
+@CJc6@iDmM&VUR0Z3!-8BMX$E6DA@XC9Zb%*)@VHehA6Adl2V8`L(9AFp$+q2cAN
+-'!iaKSJBe!9e6L,5L$F4m3I$'""L3!4"L(TlFR-m1f,Xmrhrlp[VfkDE3-kjIrF
+e(9Bf*!m4%"!!%"!!%"!KlYr9+e'2"hm8e44bT)39fD8Lhi5,h&+PE0V(A'33rM2
+85kiC%aQQcC*J)MBTa)44dI,SF"$1`C[dpBF8CheXm%ia)DA023S%a$6cG$9``Ka
+cpkPdYecbH1TY+5XmRVZQXC[r'+C"MKBbC[Q(mU3iam,k'X@AXN*42U0EVqR@b@l
+G%!f%fV3B`Ll1*#P1G!-`2!$qMGeHPQ1hIhAkk[5FXRfPDHRfr#2TfVhCA,bXVjp
+E(k1Ml!)6*6*BSecYRU$BC#I@VB*bqNr2HiIJX"fR9)Eci,E@i9Bm'1GTM4j@c(`
+j9c!UQT2L9!*#KDh4c*8RkmR&4SGUJe$GkNDRTBN3UHU&p@Ef%SSp1a$(MlRHHXa
+G1aA4%D0Y"2laX"Y,DI*ZT5f[deM@L4mcIQcimH+R(cmqr$4&l%%l(IAPdSc5#Si
+D`&PPakE*A51'I[)heFdk)%Qd!@8R0%dk10b94JNG"3bm-N)LcEX1+%l&58J9jkU
+'3XdF`&`KA#[XpL2TTR8El#'YTLFY0b0(@aE)5C@q2r3RZldiVI")XGCHQKQf2b5
+2[rUd2D%d3iA[A3fdl`he2&km*F$8aqSYlS06Rp@NK#f(K+RR`ShiFcPiF1Uj%&5
+je`A(2%Gd*(V)2I@Nk'kBIXhi`HP6ZbmZQGSGc9cZLckR+%H15FUAG6F30T9%M4G
+-Pf[FR1PicR3FQ)i2MGCEM"K1%0hHkGFm#BD6`(!5'%D)i5p@qc&F6Jb$YdF)dIm
+'hfF$3kLh`Ae`lA1DbQMQfQ+DpYa`02-aHRb"P%`h,B"0,LZEYFp40F'8[r)TAjU
+Q2)r(,491q5ZE8R)V65NaQkDXaq2CLUD8h#T0+H46MY18`kXB@59P01A2EaP-+C5
+QI-1R2'ZD!V*+p"91qBC0@ANh69RCBTS#XPBf964PjGem-qlJmSE3p180EKHfI$X
+[,PPH4k$LDKqMDHpZ`FHR#"M@MfFV,bjC%k2MqRpF[YR`SaU61c1Aepd49HVB`jS
+B2BLi8Fr'PN*d1`Pa#f*e495#lMUA0'8c$F-b!3+4P@ArBR`F3d#`IM`crZ+5Y8%
+kT[r(0I--2kSa'53%'$RdX$E)b&NEl)SF2Q8H$31i!Z4XKa246*Am6EZpN!"%bp9
+qSU9Z"`61hQa606*e#BX6!'D%3V1JcNpaJ6)P#M$)YmXhXeX5rhLX%lrY,&I-RD8
+3U"h5akIi4kIaac@aSKqAEcEqL%&Mk2MI"bMA"ZAE0I2BVF3Q8(5j0@1+XPiEV)#
+%HFBI!D3SG6hqh3k[SJ5`XUS"$%)qSR&fE(&XGpFS)kUc$)%eG@iP+Bkr1)91D36
+LQ(FKMNIFf#"8dBXmL2k)[+"VAf&a@VV@*2[qJ29+#qfDdQ*YIUl'[Pq@JA@&j8G
+5l6QT4dTcd[(CcVT"*J)*iC&b*E)'lL99#b2N5$jE-1aKQe$5FRp1IbkMF+a@kqV
+SemY([hZ$hp'[Ii9(,kb3!*V#aqISNef0"c2eY%@%jD,P5T1I'@"Nl2#&SU@CqEQ
+QBp8pa&C+cdR9(XQF2*6PlR)lkqa3[G23PHHkVNhAjY$8XH!Cf&qXF2-[er8(B`$
+8KNQfc1,kp2+drCP(-TiE@cj)([%3Spb--QfUTMKYreJb!N)@8KG+MZ$kZDMD!94
+XA8S(!U@&0X(MJ4VQEFGLMPMNJ'+1rbNfGGSE,,*)G0fFq`S@P`m4cMp5H%"cT,4
+iE"MY0c'k0Lell''arp9@cUlV`9JVCpFm!iA&Y9'YbGE4F&89Db*LK6EFLLS@fr+
+LV6S5F0NHKid8+`6&`[C8ZeKeeDV#)DUJ@&fc+C82`B)m[U9q92&e2)*0NLLfmFa
+CF")8jkQAHVBkR1UPf2EeTP8L01M[h#Q1L-j8-@ZheMQTfY'#MF*Bji[Y#a*FQX@
+GkKX4XYbiq59-4SMP6GYlYJPXqhrbL1)VDkIE%!B%Spj4J10GapNAP$1@qX6kQ!6
+!I5NG3583&rD8Z&5f"$!)p4'EM#p&TacSZDirR"l1cFNB+cAU)6eLarBC(pZ'BjX
+RHfacj`M5F,SqpQBFh'`kYJ#QCKcD9YC#Nh&S-cq`eh685MTU%MYUHh!NG1(XU0'
+"pIc!22A!GHhKG*9f,!r-U`fU(p)VN!##1)eA3jJSfJ2KY25aiFKHr&P$mdX0$Cp
+pD@&Y4QCDQEESSJGSd660@0ApBS0erNc-bNT6*l0m9iSYQZF0dlqP`lh$Xea895Y
+!Gi58(%Pa0QaI3N#US1bpVU$b0LRf"i4L(TB3QJHh@jAE5lIaA,NE4VHrkqLrfA+
+,Rf*[9ck2Xr9i2(k+[ESfLMfCVVYRrf38ZmV(0Z2BFmNeB$hfMIUE*-8f(IYkNh,
+ED")1EGjZS0VESGVmX&$Yq![EM99l8fe8Hf,'5Ue9ZfZ1MjpUGlhSf+Pf+hF)!-'
+U6ZV)!m0*`j4ifcP-L!qF5cV(((AU*I2+qCm![8DiCkB(dr#[1SHj3F`rG@a!SZr
+0p)'1a9l!8*!!M'4P+dca1TJ)VHa$aJ*ki-(Gbm%SmLY&8`IBP0*a9Z&K&"q#`@0
+Zl9(f%8[DA$"eIZ95T1PRB*FbS%e1S09DI031C2GGjRqbV5#l,r[9"*QLr+('!'5
+mZ[L$l%qe"YPN+NUYeG)!C+FBb)`"CU"JQb4`1HQK)R"CJI9rS9CTMjGDrC)f0(5
+N!NK2Jc"G&"V@Q3HpG"Xr$'Ia"EL2eiX*35p5dR6+D8hj`A+Pc[-8rh2#MDdk96X
+f$*j#8J)P+h$R"9`,#C9HF5qI%1-T[BXFLR,9`EfH#H,HHmZ9djiIK*&5ePlYqF%
+HeleUcaY)mh`$$#B3Jk0E2ir$m#aX(Bd6HrM`5G,`5AciC3brM1(MM)E[%42%!&a
+&Tk[0p`Bm9ql0m&ca2)PdQbFTbGQYD-k+(q2&Mm+0R0'2pVJ1IZc*m1i@%`i'X+8
+Ei-YF`,3,RQIJ"Tq$$eGlTQ%lT0Vc$*mbEC-,'a(H`@IS(`ma`Y59!*8&c2f0lCe
+95U-B$m"%2#r`2m-!cc$5jRm*d2ih`(Jr!2@#C`fPCPK9!KeC(cHdqf"Sah0JrEG
+M4)bR`p5BaBXJHla%pRL3!(h4N`UbicQ"bd(HFNV"3`Tf4D6e5Sjj,!mhei*)r,e
+(FF`T%VXTHebhUTA6h,&aKVpkQEpiHBp,G02b-#4rkGf09eGlhZ)$IX`"mKBIpQ-
+1%!!HLT*2*UGkbEYlX"QmY419DGe5GNXE#NR$Y)%HcE`rMp$empi3("@5LlS0Yc`
+pR4iAHfN3Hm6!68RF*BVEF3$E9XmBFTXHH!X$i'5mAc3GY1PJJLHESh'fK-DA314
+,UBRkh8MK'FAK4c8e)'6fYH9+JqGeE2'p2X5GL0M8DKH2B5Z08QQb6BSl)Qp3ZIC
+TLR26blZUKa-,eUXNHL4"[G3UHZjEqXT&ckXYRY-H4r(-dU#c'fd@T4%Zf,iG5cf
+Y54HJ9+fN9!Jj+eRK$L)mHN$4QFbcrT31(p)NSC)@(+%IB8alJN[9JTqm"*l`L5f
+al4I"#-RV-"$,1V'e&r'HLEULHP)rZ1K1K&cBkU+YXaDNIfc9AN9%U2SS09ibl'l
+1c8J[,pANM+@lcT0&5N!S*fG&p+L"Sb,,kUL`)M&jRJQ*18"kT49TY1Q)SlEcbI1
+XNf'm9[Th-8PXJ5h@3HKQEM%KHDqI3k6UKbVL$Q&EUkFi#R&-'k8PZRqU4&6HX)q
+%K1),0T+Bd0M#RSL,YJ3KU-IVJ&38IQ!%qe)kG$,"4SkEX&Fr#U(@k6i%9fZ6Zkr
+Bai)BbGdD-c%mMT4)L$k%hSHBilA-khD4q&0C"jd1QcQl8q*1fNUi%aA0G'XfhGS
+'X9J%T[fZ[BU6&B)"X1`'TRM9`99P3ea1'M%#SpF35-%+J&4MiF!fZlY9A[GSKM'
+3!1qh9D0`5,r'LCF4$X46lY(L-hj!0*k`KJ5ldSq+%k1IVedUdG&j'%8b$MILaGP
+8-qpLcSJ(%)Mp86'r1HaS16cNX))i&Hb(AP$UR@*L*aIccShebQ43-QM%YJTSN9R
+PVkP@)Nm6Lk3iNjJZ03KFUSkLX3YE*XRT(hbMqrU$4p(4EpEN`I'Z$$e&(EPLdr4
+,0b4FR%MmYZ&P2VB0EP(Td0PX*R(!4"!kr`@mmer!4C((0,`1M#XpP"$bN980-(b
+MT!L6M#T,)aKXT%5qHc18lhMQmkNE-%L2Rk[`mhImV**ZjN--%4%E*,DfP!jdNqr
+KjbEHZGp%hB'N##4)c5KmJD-e[Jl6D,lRll5p35R-4F3S"d$M8icmaZa"Z!fah*H
+$Gb,Y`%)LR!EIl1-NhX@0R%HKT2K$kDNJIJ&%rPdK-K9QNG%3,&GXR6[reP[j)Y)
+dU!YB9*pA2jF1"1*RiHBZIT!!4,pMr*F2MP@[Nik!lZ!5b)qAMZ&c&%Z#P#Fkr&Y
+Vf-10aSpJ50i&%K[P9pqGaY-jVJF4LcSqU6B2hPRrU8cqT8hmC5F4L24I9iKF%,r
+$%#T%jMH)(3dTiG[*0F%,6f+!$SGb9(-3pKF"B(m&"&D(+-e[0KRH-#GY5)H#BIU
+hhKA[DEld(djJrpaD*Il9d,eHp6S"AbVIBSUN)E@T(Nj!')HUQ13SFHE$BF#hPR)
+6aT(c!#kr2(VT(D8(9PK5Y,!KVNY&R,UeSJ09lEKFe@KMM9Hd0UCSPSdQeddlZ56
+T%DMAHHKP#DpSk'MNF-41D8`Im@Vf8C+NUTBf-(4k0NZZ*5H3!(3"2cH%@c$XJUB
+5J0r-$GGRBAaZpT3!p#Aiq'`iKQ,"52T2Y4$V4#GBhm#0jBCG*-$FEbreh)$(Kc"
+eQ)SFSiMTX'*$jAREmak4qIX-chXH$kpUli'-'+qX%bM`mD[Q9dR92-P)h&GlVN*
+9(d!U`*!![-R)MlD"(ff$I,5K%Lchrcfc11YaB"+@L[NqJ*mFk@D@*!E'5FYkH39
+k#6mrim6pV')a-23CQ-rb2-#"TcF#AKpqVZ2!kq2!dh2J63,`p*la!0jiI*`N!Hm
+k)q"GC`#mkb6JZ56JZEMcMm$fJ!5f"b"HeZ%)afAeAlb2#m#V!R(&Hkf!#5UNNJ$
++fBSUIZ2*fbeqe6iVB5$Fq#9e8l'-,lPi@XBVm6+)TSdQd66(ZS!1#a4d[F$T*ZI
+YHIj,b'*0Yj-%fm%GRYpa&#f5#N(-i8+0&lcar+lH*L&SN4q#rZX8#EK23@E0el*
+Jde8Sf*lPa9$CdP-330i9L'-(JP#ka0'hbJKpcq0R)dIImaapUcMkaJ"pUj!!3Ne
+TadM1PG#hd3Kp'`h3Ye&#hf%*IBG0k,Y,3YpGQ(E#8(Kj6KJ*VhfjBbHjXZ@8-@C
+`NmKJ'rC3A,lYXC,%"3VPHGpe02P[AM"986P*U"PYDedUXV&@@r2r#CNFpC*CJje
+Z*#PhN46(!GP%!8qYdr'HX)S),,1C"CN8eYh'%`3Pajk1hqL3!09-j!"TFX"Tm-&
+Xm)(#,L5N+QC6D()2#dfN!A*iFSp"H$,I5KDaK1*A(+*XpKriHi3TaQNmVTk+`Y'
+*`em+4rpNhlYMj+,brd5S16&h`eL%QUlMTP$cR9Fee(brLU&Q,C*#[LHKjSKaU#Q
+P0$eHSHC)V8209f(,jh%)0ApR%'U1')HD%K#0*f`U%QT@1aS3DQlh#c9eFUMT[qA
+hTZYl'RL1[+,!mpAH,T[L&hL1F)0iNmC-+68`c8lD-M`HK*aRT"ZcL"F3293-RB@
+8B4M'lkZUdB9XBKpPi85''$FLVk0!MM0d5T-ZF50P25DYpc03Hb8PQ@)3K[C#X,C
+G#pAbh-#REX'Je8CKk*Fm"%@"@FR!fH)A`2d92rrNKX)r$3a3*0LcJcD1J`RkMmN
+%SK*!'[H`)c5q))@L"BDK+#GcF3@Kk!hS%KE(9cd8A6c4824k(1'iG*3cMJar!iJ
+)jNCElq-FM0B9#8BEZJK'ceC)BYIKD)("K&U'Sj02pC,$dHe&`p%BNFE#cDpK9['
+0HKk3!$D-dS1T%P$M!9825bG,Md&B1L+&TC,D14Y-JDNhAJT-'h5HKAKePPFr#%#
+rX(3pVhMVNdb+DeR+cI00XRPH*1AK!RFCX6"e1a##M8SJ03['qLE2'UK2$!YNmD+
+rP2a!4B`@'*RX#hKDZG9XaqYHE2DmVCHfHib#9K4pqXMc$KhKS3c21jk&f$Kj"`5
+Qm)Vp"*Ci`NmNc+m`C*d[KD`4[j!!G3XrpKEVXBGD8DdrmGc(Q8mc#PTR58%VhG`
+R#BeTIN(4Er#cJJZ0&8@%4V[%IJaHhaGe)9&b&JI[kLl"fiHIG9)J5q"GcF%l"H"
+GlAPG!Zm8+YaT!Zmk)r#Z+`,HGAlJ03KV(k*JQJ!l#i*U839"lA`%YG%+JPTIa5+
+NmGR*K,8&"Q'Y9Fa9&0CfY84JV!,EaE81E-miUVX3NamCKlCH,dIVBU2`YSkMq-X
+Z8I`mG9p5X%XSrT+Mq'@Jq%[2Qa++AmE2QbB8paUKZ,F)LR[p8'`3qJ,&Lcd,Vk8
+r*`b&C#h#hSQQ`aZ&[5-ml'AGH)dTm(8f')5pfa85N46fNZKXU%hB1l&3a#MXIH"
+l%[BqX'%LBHr)+`PlHCM%`Yjh(VH`prfUKld6hB3e$RXA`UKB+"rPfQ,1[L%Aa3m
+d4`Ue1A)4Z-+Fjm*DiQ'hdiF+`bmr9YFrb`SA',)#8E"A#l0c%)BMUDGVMN9BhV*
+eBLch6jbP5`jZd$5M$@NAam),5e`SPAdC`ZiH5N+J&!8Uf+pHmQ%q06l)%a5@FAI
+A(2@5qhmCpS4FETpQ-DVkbb'A3C,#(*DN`'iT33(6H%-D2CJUQVdhDT!!![(K&,i
+!&UcKKFmq6ke24,U#bj5Zi)13!2'biR48@$k)3MK)$*Q0*!DA,J(T)Ll9kE"&2pT
+T1EllT'ZE@N&cDYX%U'LPiZ4'AJ&[lN0Qd,B0kXU6EG$`(JqYU2'T#rA84-q&HKi
+5P@e(BX`SQV5%N!"qGrVp1rFT*-3Jc'29lpCrbJS#'DH13%(AXE34L0X(hG1RMP1
+eK2"(MF*q1M-CUYBM4++Fr&jHL+S%M4pN49!X%!I!Rmk$8bI4)G$)%3VJ64d[ZT'
+Sc`[!fTGa%`0(fd9(Uj'10SdkGp24qL"+E@)lIrAQ`FbT%p!03kKlAZH0,L$dJ2"
+pXkXNCRl%#!KD`dbK#JkjLKe5&`[fQF4`SA&je$rp`C6,J&+CAAZET1qRMa56,ZD
+NTA)Ae0I&KE+1qVmc&@ePc@la*YK#3Dr1FMX9KNYN4E-@#b8$e'fAG3C$3B6#0hf
+!T'XJ9daXkd1!Df(KG4N[SLihQq@+3eX%T5pSAl8$Q%K&FKLUUA[kbLa0,$4pjCj
+$Q5[hV-`+(PbC*4i,"L)l48X@4$b5iLdcKa'iQb0K-aUUS5CNV8@1)kc)X9Hpj*p
+R)Va,8#qCf43C&Sr9H)-AG4F0fGH!I@@LQ*Me8m@T29ZG'(SDc*6k6kAL[RVH%HH
+a"Gr@9jZ4+2@a,S#L`F'%*a5RaLQ11)BkYJ5MZTdSrY[1#JT,SKK&i6k2`lB4'VS
+9ch'LMiN"+Q)Aq4F3lMDT`ekl[EDL8JBQ"(Kj'NTjTD,8EK%`&KJGY!"J,*J)',1
++J0%'0a4hiBedSRN4+`Mp@!1%"Ir()(br+!LVf%98$%P$8+ib1[!UJ(,9f)0bj`e
+qS24M$9#ZqTm-b[eM#FVD&b1IQ@3Y4Vlbk#X[4Mlc&pCLj#ZcUe#-2)XDAkBQ%&#
+BqKR08GQ"2IM@a58VTmQZE6)LJflH#4JiX,%-6b2-'%-LP*ET`ZPYj0$QaE'I8@-
+"8l-&KF9(dNQff[e!,4HDE#A!'RH5rUU@SNG4ljK-q[Y"0"h8bP+hCqE,"NJ33Mk
+D160IQR+'ZJVMia8KZe-Zm2R[Q8F1D1eG8bJh28T9+#Je*JH6U6r58h+K6(G,Hch
+[S[FQLHk1$cV0mekMIdYIfcJmDrIhA6iPrYcDpCr(D4I`*%QfFE'p,!hCfhC$#GP
+$46RSIqE8I+L"[H'PLM12T"m`)S8em0#13lDXh&!B1Dci3"K)X6&5cP*`D0(hZ9(
+X4*-(%Ml4cZ*93pSi!3(TK8Fb+UDLLq8CF@0(K+SS%ImU%j'4PP0l+RJ6YPr(`FP
+e*TLQR&Vl59P`ArYfTqeBSk*e0PJF[0Kl,iUl,bZq2XZX0(brcX9*Z%(F'4r('kc
+0GA@#K*bdh(!B&E`#A,#9UVV3dSNYK1K`FJY"[-&KTdY6[*eT+&5d[LcQp89GTr8
+r@DpG*)lSb!eh"aMY,bh6CP5S1BAdrhl&AeeT`i,8&BC32j!!GAEYqM,IlCCEcX$
+jci4T(8)XrGVeJ6MYE#-&hB@P-SkNTPS$fL*+@KJSj'LiAB'6XFR@dkL8pF[!Q&2
+Fd'"@D-Z!LPA$c$5(%DJTD%Dq`S%@HH"ar6(&Te3i+-pi8*0b4[(QIBYEFX1f1k1
+lShqTaPB@0AA2&[)QdUY+4BpQ2-0$dNHR2%AIMFr1bC!!**T)rkc#!9kMSc9-KT&
+J00!KNA&*Q9,&+B,4`,2q!hP6c#jTD!a-A@``EqBC0fmbDDCjVJ)%NT*!bCaN9RB
+1hj'QY0$$l*2m`DbBhi8LSV$ANiSC$Dm[Q9P'`IlJ0R6A1k!DTih$E)PV)49"kk,
+#jRpGE0"`a'PD,$)-ekj0CB-EM4NA,b-JLkRbQ+RE9B-,rShmQ&E2PT`jU$LST$j
+88YhCpZKSp!-T`FT$eG4V85rjBc'f24Z3!-EHf1m+869G)1lN$S6*#B0#dRQUA99
+GjT'*,914+2"EjY-',+($8R83#T%1Z'MpZa9mEX$R5M+E)Sh2+kYhPcQIEi`N"UF
+UBQ5U8TQUZ2H!8hI0d&F$BI-D9b&5rH1E1d1KNqh680MLFAJ)l(jf3$['d@,m-E6
+lf6hDTGim((iH$Rme$Tq@Dm+IS5R@XcG8bN4,L2j#[S3N%I1T&q#)3'8EF(!4"fr
+U011f%VHk'[1m+r4[kC8EKQF09#FDJ+1TFkULNm!aaJ3146NR*S5Db4%UIKAIJ@E
+3([G($U"c$UrrC`kL133L-i(S0*N&'C1(%1P)L)[k!##ehlKb84+$&1+-358lLN$
+4(BKM9HI(a[A@N!$eA[p+DX4SRRV*SjHV`+M3bSJ+q`0CC[(h@@h&H94F%ZQj[!'
+!jNbFVY4UFTILI`04C+D(4kN)$!NERI&UTkqfIkc0d+E#3UZ!r!VB4+V)TY!B#04
+-(@Xq#kN'j(Ke`P@c&CGr#)@TFHllBD)kq6E,BDRK,&H5h!543aI&C5kFc)d5C-e
+Xc@A0E"Qi8@C,4CqXM@[Ypa1VVhlM@S%ZhXP"$B)$FJ(59LJDpC[,h#PL3S5fFGd
+L&5E'LkiF4q*1hRLBC1Ll[U+H4jAakVK8S1U%'HlkP,S3pf#El"b(ZIqj99hMUJ&
+FK#Xc(9)$&cc8A+a)aA9m8Z-ZSTm1'i*%9S3jXSQVBmd9HQepYb#@J[!BVTTMG2B
+LDf!L@LEZ'%A)iql"0(qR+"+NlT&FSQLHD[CUUdX8$HY9k[Uf(8-Bl*`jE!dlYlP
+KPMXMa3Mf8641CBid*je,'0@dQSblIFB1Zk[VXV@&"1e!6lB*09BFd'H#5DJ(YpB
+!'0Y*f(b3!%+a+"kkSmraa[fN-"5"*QfDpQ[bH##i!"pZP"jZa--0dX-0H2L(p2!
+22-bA(ZEMiHr5`praF*AdF"8HVT%HVX($21PK(KlZNalZ`m-Xk@%@(Kk3!"iHU&h
+3rTM2+'MA[r+JrE'lMB,fp4-*fR0TXj!!`+Zp4'aAhLprq'TG)#iPGq")IPTUMU,
+!jA+rCVYlHX(XY$-*q#-H,*Jp%`AM9Xi@iEa"3iciQ2%J6r#Ci*kqBKQ5!$*A,%Y
+T'm4$I6ec+iH#5@$CTceF#SjJZ@)1-9Xa4cbiBJia+jJM-eXa*`11l4AhF$EhF$E
+h2(P25Qkhh5j0Pm`M,e,Jqm-@ebJFeECGf,lDeaTd"mi(cT-3V)q&CrH1`Kh,RE(
+aBASNKhDi98mEAFqDYj)`STF*'94-N4P1E`a#)`p!C'G!M13@jY"LTrBK@")Vkj8
+)*MqKf#)jjUe"0ea@jSiY2$dX0l)cZr@GjKU,,V'NZb`5J5-F(dl@@!T``4LGCHd
+R'KZUMfPi5EGf[QKTkdi03-cCN!#Z`XQ)AiAQ52J#fd!Jb)Zam$Bq4TdLQhUCNCH
+HQmr['#KZ"RNq'#j04%6iZhpT&RHqr8%N'VlV,ffld1#b426)2r@r1PITGXp3l40
+$GjD6q8d1XGYf+VBl3q6NaUdjFKl,YY1bAmG(KNd2$j,+S0QLmhGL%(jXi9BaT'm
+,+PP2+1C#jlBHfKcl(1!la`JX,XeJa#PRj$!cYA964hKSGdIBZIXR5,lK4!9(EY,
+rkRcPcZAADCc"*aAEmVpTc)20Jf#+aS14UR0E+5F6Ih"V)eGk%TVPZF!@bFf3!*E
+KCN!p%0[SQST*Z1#DZ0Xp9I'LU5hRlMEFpUYX@,S0MeNq**[FYYZh05AhC))%4'0
+FFqFPQB$9pBVZK9EGZa[k`N2k2MQB#bV21pFh4hEqmkrKKASi'h(C)S[m8UG!eI,
+3P-HRXX+KL3XdlB%YJDIaLU%ic"XXeDR1S[&,'fXficB)d9d%9MGYA(1(BZjP%h(
+Ti@**i9[1!)a08%)al04hD2*VYL%P0K(Nd5AFGJ!diC6Fi)lIE!TrqTIQF#Z"Hq1
+H6Dl4CJaTeX31YflT@,$RcVlS9R&[CH#,pq$dK0&K"E)1Yb)%q@dMG,%EaNjQff`
+L*e1EUY,DdD4b0N-Z318&J[Z"cZD)J[3#IH81,$K$%f)%-',dZhFc-Tah![6meJc
+PA1kMj$IREY`%ieH#*0e2S3,V0%1$*lT'[L%a'GV$1F`NJm"S4FTJjSV@cMEaUpY
+f+-ilm!"P`"raY8-l9V3kB[5Rml8lGT!!LGJRU3me[K)NG`LD)qdF@I'*CUMj[C9
+,9V4UR$4FI&&PlQaQ$!H"mX&QF8I36Lk5ET-#8MF&3@6,'e88lrH(4MfHCBTY&#Q
+!5PNH,[(35"GK)[4V9U(MM9&5$Cc020N*'d9F-8*Pl1CiUXMGSZceC9S!4pa[clG
+@pJBUp!-%IfIMk#CAX$%F+('9$@8(q2(ck,#1'&[Zq,+NZ'!8c[Dj6%b4F#Z")C2
+[-bhELkB$jJEJ-$[NaX3'L#hR@MVk!TQ&P@$'`(JUh2%l!m2Xa@qNEK`1m05d6(X
+fV+e`@PTa1LHC+P6r9qGCPF'&%da#PiPUh8kSa!NN%l3c`8`AMi2k0$rVNT[-TA4
+Z#8!6f)eQ)aH)@2UP-ZeN&Mp&LiX)cL*h)XL&-Y3VPG6920EdYMi5[6-!mk8pD94
+R`BZk6LG,)UP8DK3S09*H455k`!Kc2ImIm`I%a!3A,T5cZl!FJ[3$hAQB2NkGqp@
+j$I39G'ZR19U-@BIkD-N#PrB4hANL1pA'NQI95eCXI4Z&Gf"m"3$1U8S$kaK1lLd
+pA*%impfXJmXX@lQ)3cZF56"##NlQYiS@IiE"D0+`,ZTZdab2([l1&(Vel@I'b2m
+FVN9FBXrpUq(+U"l*G1*aA$,,l1"GUDIe+aI5NZlTaFBRNSGX8**hC9GkdR$`($H
+(ih8`SkPK-Y'G0-`B[Z521%hTB@fC&A@FF0'3!("dq8fr1QG)[JlN9dCh!5#9jl#
+KBpD)`AK5I&8r05iXN@+M6cM3R-%6Jc-B#Emf9"ir)RLP0Q[bU,,Lq-G+A2Nf9M&
+qG3lE$P)eqrBc9$--k-lN[#4R-6PZi'+kRJ%Yb)#@i!qdS++cF,BYp4+4R`d'L,&
+%F*,NdZh6T'STIB)U$X"4fA#T8Dr(`HC%9G*Jab-J`ShU1i,dlKD9e*M8C`Y"jTQ
+K!`Y[362,"b#&R#!T"PGBLiT%f3M-Pc8mN!$+2BmSKEGiL6-`FFB"Elb8ekm*bk&
+X$bd(&[2P`S4J`YTLi%a))&-i(['+3`Pl8)%lfhp[De3HeZ5eVd*5E!`2-Bd6$`q
+(AQ0$0&GaPaZd&lQS13`I%(d3JGVd,KR'1-1(1F1(1F1B-F2rY$,-560L4`E$E@L
+58)RJMiJN**hLddq$N`F*5IMNJk-kpiUGqVQ`(3Np'QfUNF%*e$*JI)j'1V,JpU&
+LIEZ1%L-i'+-mIDj'DDUR"ZJZTF"%#Jq98))IQS0('+Q$@MU$Z('2UZ5L6,P)X0#
+Kb5mI,KCV84)eATN*AbB%Se"K!kp3r(LNc)JSRmP&L18L5+GVdTQ$#-C8S9dpLUj
+#KN2Bh$)N9#"#aEP%TJ&j2LYjTQ-VXQTHPT%Z8d3NL33Q1LT8l@'0cDT%k23pZ"J
+A*L*9!UlB4qDL!M3@S*K1H*mH+5B2QUQC&%dl6jjrQ&M)%m+@%PIQGLp0-LFSIc6
+MQSVcKQU8faAcERbNea`&$3#[j9XA(++RcEmA'pPN0P#Kbr#D@9$!Ml%Zb*0X0(P
+)aY0TDR!C1jI'CPhDi@86q5HE-6%*K%3!'e[#%EKJ[Hcc1EXGVB[CbFh!$3)!`4`
+pM)ES@AFefifNl8abfdB)R-3%5YaLc%LZq$pIR%6ZVp`"$6J@-T!!3K4k1D,TiJA
+kG`LF1ddJGVT(VD!PCG2`T#,Y+3B`K)a$UIXf%B"IT!)iUTYK2SkU6L(-'j,"B5U
+'`5rAk`Ff%5ik#I&*F6)+9"8K+Bq3!$M,r,A#$NE+L$4V8G-T,r2cFJ*$4C10JHV
+YNeQG9F#X`@e4jB9M"DkU-1)251Sh)39Yh2NKa9BK8UU0N!$5Eb*NUM)Ac1U9Z3i
+djB)3PRFjpT'!K"l`,V3U2)@#-KPq+Lm"9"DIf$DQ#RFXT3hA[6a+SRR`*+UT%`h
+1a2%0LLCCG!1Y6P4NUE&JaUCE`q@d8FSp&ZD%r@)e%m-996Vf5UjN#3U4a6ibK0T
+`69HYcELLX"GI+daNQG$H`JE*drQP0+5&i*b6'Vc*Am1,*`eP+j0$''2"'%*8q4M
+Uf1GZ$CFUG-a%FZkHaR%fP@+C(A@0YL%8bXZ$Z"p#eGfQ2)c!lSj$`KH9B8m01Z(
+qE5!9U"#h+6lkJ1!Kd[%B(22EP,U0`jKXdH)bHfH'[Kii15!fdT!!EVXQ4dXpPL)
+l+I+Mj+3BN!#qQd3XM#JV@!(%2!)e4*Hd2"1)-UJd1S2$qi`1lcH&#ajF5P!#AP5
+Rh-Ll&+V)UM)CDGmUUL6'h%H9)XrQ9#bD[6!,I8LMmCA&F2',ZS+TLUr3c%$UD+#
+AEAe304Lk50-MXH0V`a#kf)3aUKejl&%5&XGJ-1e$&d90)%54i!$M'3k!CLiH[&d
+I!dR0YPhSK'4%XXm!,T@D8L46bJB3Hf%FeV1,EH4[B)%1!CZ0UfH$E(*P+rXF(69
+[#T,-+fdQ'[6PAF`T-JIkQ9PlYPkj1bc#6)DV0'bTHI(B`!CACD,+p[+!Z#2dQRF
+dB8#c#*hC@G%5&3D&6NZ1EqD6D$V,FYq`DhHhUmEjb"8-Va0h*,f'"-`Ur`(Ep5r
+F[U([ITSH-heF&,CXFD(5aU6&qc5,X%&kQ)XLj!BA)f60a"(8P#Dci&!8lM(U3Z%
+&,8fc``Be1EEfFDF@9#-c,jaAiNVMSS@#(8Sr8LrjSZ&Y24Q9ZN"N*0bi3UmD'Q`
+10kl9Bq'BTS@V&"FmI%T-%k20!(,R`4PX56R*ZQpk13"h1%N6-[GJbNcr)SVQ#4S
+**@jkU'EG##jb3meBfGa#I"aYE`2a88Fl(H+lHKcL(R)DIK(0EL4$%#C+BEP@LN(
+5+1HALef1F1d%''9BJ+SiABL"#F6kGU#lRbqKLlK3k13NljDP#a6c)0KZ4d09C9D
+HA6$PV2KRj44MaB[cQKLpBEI[6bf&T@rL4!dm[b'E[UE2U$V1(jhL"QhkFqPfbDS
+RNh(+l4b9p&NbbHPc"%%#&`hPA1!kL@fi!GkJa0PQAY#P!6mk4k9l6eV,N!"1q9"
+*4#!U+SN1VhY2XFhdbDXNGJijmP*"F+T(E+4U3GNA9Y-AK0PkA9eZLf$ckHRp8,$
+#m(1'Np!S!&i2dqY-&245q(mAK*la9`d,Aehjch1V"i42CLhif3*Kbk2dRpTpeee
+#U[SfGFUalkX2UE15,b3[&q,a-qCTp8qAcTSKT!SRe8kejE(NV#YUYr#'F%hb-rV
+H,ci8-S5r#cPcNYF+2@T&(YLZrR4fmY6,kTm,8i4Pb5mRIr2K0am*BH'2dNKKfG2
+#V16,b41%%qZ5[jNRV%bq,2`[IPB,jG1%hiiANXF,*CbfMhr`i2QRaielHR$,PF'
+iJ5[G!d*!+"-qI[VA9li4IVdJZ82S@l$$)q"5FFT$kKp-%pjrp&(KIappp10lCJL
+M-i6RC`L6(K1@RKMS&YkB)DaA&rBX5liY1Ap`[c"EII6B`H6[*(meq+EDeLbF'ha
+`f[+p%pU%[d`VkE%,FG-%fV3D,cJ!%RZhZSba&GjrDp'L,r!Mr$YH(,P3X1*#`A*
+ebQ#Em&YeR[$5&@&!2I1Tep9VVJJR9jd3cR8)(38r9"p0GL5r*4`@rQATB'*[FNj
+bmf"CpcI#bp+)EhkScNRqCI+E`Qq&e+@$04mQ&bB2U$Gbb[)ac[($*iAT`K*eSr"
+$i4VKq0-R9`JAKF'HeDqV[a@q&+B12rR0CD(R`XqkKGFAU9qmdLGmI-f%"liCdbI
+mj!I#aI(GilYRR"mRG#qI0N8SA$RMp4NRKB[cKBprrH-6,`NAAa1qIHBh3RD(m-b
+[qhjdVR[-H3#3!aJ!!#5)!!"AZ!#3!`J!N!-J!!!r2!!(UI!!N!-+@-!!5S!!!%U
+!!*!$'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"!!!"N!#h!!'2Y`!!"&J'dcI8!`i
+!N!-F!li!%d4*9%`!$3#L38a59!!+!8T69&)J!!%"cP"cCA3!!!(Q4%a24`!#!I*
+69&)M!!!#&P"*3e3!!!)LGQ9bF`!"!LjMD@0Z!!!#4NP$6di!!!*55801)`!%!Pj
+'8N9'!!3#QN*14%`!!3,@399c-J!!!ZjKGA0d!!%#qQPME$J!!!-53dp%43!(!aj
+%394"!!!$IP0*@N8!!!1+4Q9KG!!!!jB%!Irr)!#3#)Arrb3!!)!'dcG!!)Irr`#
+3!pB!N!@'rrmN!!%Q"Y-h&!#!rrm!!!'R!*!&YIrr)!!#"3#3"B,rr`!!!RF!N!3
+$k2rr)!!#e3#3"BMrr`!!!`%!N!3#!2rr!!!$f3#3"!)"rrm!!!3A!*!%"%X!+!3
+!&)!'dcAd"+rrr`!!&0!!N!3""`!d)!!9$J#3"!3"rrmJ!!4M!*!&J[rr)!!%F`#
+3"BArrb3!")-'dcB3!)Irrb!!"*-!N!@'rrmN!!5M"Y-h1!#!rrmJ!!5c!*!&JIr
+r)!!%``#3"BMrrb!!"0-!N!3#!2rr)!!%j3#3"!)"rrmJ!!6e!*!%"+rrr`!!&E`
+!N!3#!*!$)!!&"3#3"!)"!!FJ!!89!*!&J2rr!!!&)3#3"!2SrrmJ!!PB!*!%"%X
+!%!3!%US'dcDX!3F!(#!!%X-!N!@!rrm!!!Pd!*!%!qMrr`!!#E3!N!8#rrmJ!"*
+k!*!&!Irr)!!5Q!#3"!4,rrm%!",I"Y-f!!4,rrm%!"3&"Y-f"!#!rrm!!"A-!*!
+&JIrr!!!@d!#3"B,rr`!!&p3!N!@$rrm!!"MB!*!&K2rr!!!Ch!#3"B$rr`!!'Z!
+!N!@"rrm!!"VV!*!&J[rr!!!DpJ#3"B2rr`!!'`%!N!@%rrm!!"X-!*!%!3$rr`!
+!'aF!N!@!rrm!!"Xh!*!(3!!!'fm!N!@%rrm!!"Z6!*!(6`!!'jF!N!@%rrm!!"[
+b!*!&!3"H(!!IpJE60U3!!J"S(!#4[`E60U!!!`"b(!#Ye!E60[3!"!"m(!$e3JE
+60V!!"3#'(!%Qc`E60V3!"J#3!"`"5Hi'dcDi!!$rrbJ"G3d!N!8(rrm!!A8h!*!
+'rrmS!''i!*!%rj!%!!&e+3#3"[rr!!'2U3#3"!C`FQpYF(3)a#"cG@CQDAJ,5@j
+cCA*d)%4TFfX,4AKTFh4TEQFJ8&F,5@jcCA*d)%4TFfX,4AKTFh4TEQFJ8&F16hG
+ZCA)JFQ9cEh9bBf816hGZCA)JFQ9cEh9bBf8*8f9RE@9ZG#!a#90PCfePER3J-JP
+6C@GYC@jd)$-*8f9RE@9ZG#!e#90PCfePER3J0JP6C@GYC@jd)$E&$3:
diff --git a/tk/mac/tkMacRegion.c b/tk/mac/tkMacRegion.c
index 7e9b4aa7565..e724996c680 100644
--- a/tk/mac/tkMacRegion.c
+++ b/tk/mac/tkMacRegion.c
@@ -12,6 +12,7 @@
*/
#include "tkInt.h"
+#include "tkMacInt.h"
#include "X.h"
#include "Xlib.h"
@@ -215,3 +216,4 @@ TkClipBox(
rect_return->width = (**rgn).rgnBBox.right - (**rgn).rgnBBox.left;
rect_return->height = (**rgn).rgnBBox.bottom - (**rgn).rgnBBox.top;
}
+
diff --git a/tk/mac/tkMacResource.r b/tk/mac/tkMacResource.r
index 66fef27da99..02c277b1e9a 100644
--- a/tk/mac/tkMacResource.r
+++ b/tk/mac/tkMacResource.r
@@ -50,14 +50,14 @@ resource 'vers' (1) {
TK_MAJOR_VERSION, MINOR_VERSION,
RELEASE_LEVEL, 0x00, verUS,
TK_PATCH_LEVEL,
- TK_PATCH_LEVEL ", by Ray Johnson © 1993-1996" "\n" "Sun Microsystems Labratories"
+ 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-1996"
+ "Wish " TK_PATCH_LEVEL " © 1993-1999"
};
@@ -73,12 +73,7 @@ resource 'vers' (2) {
* will load the TEXT resource named "Init".
*/
-read 'TEXT' (0, "Init", purgeable, preload)
- ":::tcl" TCL_VERSION ":library:init.tcl";
-read 'TEXT' (1, "History", purgeable, preload)
- ":::tcl" TCL_VERSION ":library:history.tcl";
-read 'TEXT' (2, "Word", purgeable,preload)
- ":::tcl" TCL_VERSION ":library:word.tcl";
+#include "tclMacTclCode.r"
read 'TEXT' (10, "tk", purgeable, preload) "::library:tk.tcl";
read 'TEXT' (11, "button", purgeable, preload) "::library:button.tcl";
@@ -128,18 +123,20 @@ resource 'STR#' (128, "Tcl Environment Variables") {
*/
resource 'DLOG' (128, "Default About Box", purgeable) {
- {85, 107, 243, 406}, dBoxProc, visible, goAway, 0,
+ {85, 107, 260, 412}, dBoxProc, visible, goAway, 0,
128, "", centerMainScreen
};
resource 'DITL' (128, "About Box", purgeable) {
{
- {128, 128, 148, 186}, Button {enabled, "Ok"},
- { 14, 108, 117, 310}, StaticText {disabled,
+ {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" "\n"
- "Sun Microsystems Labs" "\n" "ray.johnson@eng.sun.com"},
- { 11, 24, 111, 92}, Picture {enabled, 128}
+ 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}
}
};
@@ -503,3 +500,4 @@ resource 'MENU' (132, preload) {
textMenuProc,
0xFFFF, enabled, "", {}
};
+
diff --git a/tk/mac/tkMacScale.c b/tk/mac/tkMacScale.c
index 600a96e027b..04bdc462b73 100644
--- a/tk/mac/tkMacScale.c
+++ b/tk/mac/tkMacScale.c
@@ -5,6 +5,7 @@
* 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.
@@ -146,7 +147,8 @@ TkpDisplayScale(clientData)
CGrafPtr saveWorld;
GDHandle saveDevice;
MacDrawable *macDraw;
-
+
+ scalePtr->flags &= ~REDRAW_PENDING;
if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
goto done;
}
@@ -159,8 +161,8 @@ TkpDisplayScale(clientData)
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);
+ result = Tcl_VarEval(interp, scalePtr->command, " ", string,
+ (char *) NULL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (command executed by scale)");
Tcl_BackgroundError(interp);
@@ -168,7 +170,7 @@ TkpDisplayScale(clientData)
Tcl_Release((ClientData) interp);
}
scalePtr->flags &= ~INVOKE_COMMAND;
- if (scalePtr->tkwin == NULL) {
+ if (scalePtr->flags & SCALE_DELETED) {
Tcl_Release((ClientData) scalePtr);
return;
}
@@ -183,12 +185,9 @@ TkpDisplayScale(clientData)
if (scalePtr->highlightWidth != 0) {
GC gc;
- if (scalePtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(scalePtr->highlightColorPtr, Tk_WindowId(tkwin));
- } else {
- gc = Tk_GCForColor(scalePtr->highlightBgColorPtr, Tk_WindowId(tkwin));
- }
- Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, Tk_WindowId(tkwin));
+ 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,
@@ -236,13 +235,15 @@ TkpDisplayScale(clientData)
* 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;
+
+ (**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.
@@ -316,13 +317,13 @@ TkpScaleElement(scalePtr, x, y)
case inSlider:
return SLIDER;
case inInc:
- if (scalePtr->vertical) {
+ if (scalePtr->orient == ORIENT_VERTICAL) {
return TROUGH1;
} else {
return TROUGH2;
}
case inDecr:
- if (scalePtr->vertical) {
+ if (scalePtr->orient == ORIENT_VERTICAL) {
return TROUGH2;
} else {
return TROUGH1;
@@ -335,171 +336,6 @@ TkpScaleElement(scalePtr, x, y)
/*
*--------------------------------------------------------------
*
- * TkpSetScaleValue --
- *
- * This procedure changes the value of a scale and invokes
- * a Tcl command to reflect the current position of a scale
- *
- * Results:
- * None.
- *
- * Side effects:
- * A Tcl command is invoked, and an additional error-processing
- * command may also be invoked. The scale's slider is redrawn.
- *
- *--------------------------------------------------------------
- */
-
-void
-TkpSetScaleValue(scalePtr, value, setVar, invokeCommand)
- register TkScale *scalePtr; /* Info about widget. */
- double value; /* New value for scale. Gets adjusted
- * if it's off the scale. */
- int setVar; /* Non-zero means reflect new value through
- * to associated variable, if any. */
- int invokeCommand; /* Non-zero means invoked -command option
- * to notify of new value, 0 means don't. */
-{
- char string[PRINT_CHARS];
-
- value = TkRoundToResolution(scalePtr, value);
- if ((value < scalePtr->fromValue)
- ^ (scalePtr->toValue < scalePtr->fromValue)) {
- value = scalePtr->fromValue;
- }
- if ((value > scalePtr->toValue)
- ^ (scalePtr->toValue < scalePtr->fromValue)) {
- value = scalePtr->toValue;
- }
- if (scalePtr->flags & NEVER_SET) {
- scalePtr->flags &= ~NEVER_SET;
- } else if (scalePtr->value == value) {
- return;
- }
- scalePtr->value = value;
- if (invokeCommand) {
- scalePtr->flags |= INVOKE_COMMAND;
- }
- TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
-
- if (setVar && (scalePtr->varName != NULL)) {
- sprintf(string, scalePtr->format, scalePtr->value);
- scalePtr->flags |= SETTING_VAR;
- Tcl_SetVar(scalePtr->interp, scalePtr->varName, string,
- TCL_GLOBAL_ONLY);
- scalePtr->flags &= ~SETTING_VAR;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TkpPixelToValue --
- *
- * Given a pixel within a scale window, return the scale
- * reading corresponding to that pixel.
- *
- * Results:
- * A double-precision scale reading. If the value is outside
- * the legal range for the scale then it's rounded to the nearest
- * end of the scale.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-double
-TkpPixelToValue(scalePtr, x, y)
- register TkScale *scalePtr; /* Information about widget. */
- int x, y; /* Coordinates of point within
- * window. */
-{
- double value, pixelRange;
-
- if (scalePtr->vertical) {
- pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength
- - 2*scalePtr->inset - 2*scalePtr->borderWidth;
- value = y;
- } else {
- pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength
- - 2*scalePtr->inset - 2*scalePtr->borderWidth;
- value = x;
- }
-
- if (pixelRange <= 0) {
- /*
- * Not enough room for the slider to actually slide: just return
- * the scale's current value.
- */
-
- return scalePtr->value;
- }
- value -= scalePtr->sliderLength/2 + scalePtr->inset
- + scalePtr->borderWidth;
- value /= pixelRange;
- if (value < 0) {
- value = 0;
- }
- if (value > 1) {
- value = 1;
- }
- value = scalePtr->fromValue +
- value * (scalePtr->toValue - scalePtr->fromValue);
- return TkRoundToResolution(scalePtr, value);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TkpValueToPixel --
- *
- * Given a reading of the scale, return the x-coordinate or
- * y-coordinate corresponding to that reading, depending on
- * whether the scale is vertical or horizontal, respectively.
- *
- * Results:
- * An integer value giving the pixel location corresponding
- * to reading. The value is restricted to lie within the
- * defined range for the scale.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TkpValueToPixel(scalePtr, value)
- register TkScale *scalePtr; /* Information about widget. */
- double value; /* Reading of the widget. */
-{
- int y, pixelRange;
- double valueRange;
-
- valueRange = scalePtr->toValue - scalePtr->fromValue;
- pixelRange = (scalePtr->vertical ? Tk_Height(scalePtr->tkwin)
- : Tk_Width(scalePtr->tkwin)) - scalePtr->sliderLength
- - 2*scalePtr->inset - 2*scalePtr->borderWidth;
- if (valueRange == 0) {
- y = 0;
- } else {
- y = (int) ((value - scalePtr->fromValue) * pixelRange
- / valueRange + 0.5);
- if (y < 0) {
- y = 0;
- } else if (y > pixelRange) {
- y = pixelRange;
- }
- }
- y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth;
- return y;
-}
-
-/*
- *--------------------------------------------------------------
- *
* MacScaleEventProc --
*
* This procedure is invoked by the Tk dispatcher for
@@ -554,7 +390,7 @@ MacScaleEventProc(clientData, eventPtr)
* Update the value for the widget.
*/
macScalePtr->info.value = (**macScalePtr->scaleHandle).contrlValue;
- /* TkpSetScaleValue(&macScalePtr->info, macScalePtr->info.value, 1, 0); */
+ /* TkScaleSetValue(&macScalePtr->info, macScalePtr->info.value, 1, 0); */
/*
* The TrackControl call will "eat" the ButtonUp event. We now
@@ -595,9 +431,11 @@ ScaleActionProc(ControlRef theControl, ControlPartCode partCode)
register TkScale *scalePtr = (TkScale *) GetCRefCon(theControl);
value = (**theControl).contrlValue;
- TkpSetScaleValue(scalePtr, value, 1, 1);
+ TkScaleSetValue(scalePtr, value, 1, 1);
Tcl_Preserve((ClientData) scalePtr);
Tcl_DoOneEvent(TCL_IDLE_EVENTS);
Tcl_Release((ClientData) scalePtr);
}
+
+
diff --git a/tk/mac/tkMacScrlbr.c b/tk/mac/tkMacScrlbr.c
index d3e67b28d9e..e4e973a242c 100644
--- a/tk/mac/tkMacScrlbr.c
+++ b/tk/mac/tkMacScrlbr.c
@@ -210,17 +210,20 @@ TkpDisplayScrollbar(
* Draw the focus or any 3D relief we may have.
*/
if (scrollPtr->highlightWidth != 0) {
- GC gc;
+ GC fgGC, bgGC;
+
+ bgGC = Tk_GCForColor(scrollPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
if (scrollPtr->flags & GOT_FOCUS) {
- gc = Tk_GCForColor(scrollPtr->highlightColorPtr,
+ fgGC = Tk_GCForColor(scrollPtr->highlightColorPtr,
Tk_WindowId(tkwin));
+ TkpDrawHighlightBorder(tkwin, fgGC, bgGC, scrollPtr->highlightWidth,
+ Tk_WindowId(tkwin));
} else {
- gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr,
- Tk_WindowId(tkwin));
- }
- Tk_DrawFocusHighlight(tkwin, gc, scrollPtr->highlightWidth,
+ TkpDrawHighlightBorder(tkwin, bgGC, bgGC, scrollPtr->highlightWidth,
Tk_WindowId(tkwin));
+ }
}
Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scrollPtr->bgBorder,
scrollPtr->highlightWidth, scrollPtr->highlightWidth,
@@ -239,6 +242,7 @@ TkpDisplayScrollbar(
if (macScrollPtr->sbHandle == NULL) {
Rect r;
+ WindowRef frontNonFloating;
r.left = r.top = 0;
r.right = r.bottom = 1;
@@ -249,7 +253,14 @@ TkpDisplayScrollbar(
/*
* If we are foremost than make us active.
*/
- if ((WindowPtr) destPort == FrontWindow()) {
+
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontNonFloating = FrontNonFloatingWindow();
+ } else {
+ frontNonFloating = FrontWindow();
+ }
+
+ if ((WindowPtr) destPort == FrontWindow() || TkpIsWindowFloating((WindowPtr) destPort)) {
macScrollPtr->macFlags |= ACTIVE;
}
}
@@ -1055,3 +1066,4 @@ UpdateControlValues(
(**macScrollPtr->sbHandle).contrlVis = 255;
}
}
+
diff --git a/tk/mac/tkMacScrollbar.c b/tk/mac/tkMacScrollbar.c
new file mode 100644
index 00000000000..3a1098aef44
--- /dev/null
+++ b/tk/mac/tkMacScrollbar.c
@@ -0,0 +1,1610 @@
+/*
+ * tkMacScrollbar.c --
+ *
+ * This module implements the native Macintosh scrollbar widget
+ * 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) 1995-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkMacScrollbar.c 1.11 96/09/05 13:39:45
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+#include <Controls.h>
+#include "tkMacInt.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
+
+/*
+ * Change defines for Mac look & feel.
+ * TODO: should be moved to tkDefaults.h
+ */
+#undef DEF_SCROLLBAR_WIDTH
+#define DEF_SCROLLBAR_WIDTH "15"
+#undef DEF_SCROLLBAR_RELIEF
+#define DEF_SCROLLBAR_RELIEF "flat"
+#undef DEF_SCROLLBAR_BORDER_WIDTH
+#define DEF_SCROLLBAR_BORDER_WIDTH "0"
+#undef DEF_SCROLLBAR_HIGHLIGHT_WIDTH
+#define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "0"
+
+/*
+ * A data structure of the following type is kept for each scrollbar
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the scrollbar. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display containing widget. Used, among
+ * other things, so that resources can be
+ * freed even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with scrollbar. */
+ Tcl_Command widgetCmd; /* Token for scrollbar's widget command. */
+ Tk_Uid orientUid; /* Orientation for window ("vertical" or
+ * "horizontal"). */
+ int vertical; /* Non-zero means vertical orientation
+ * requested, zero means horizontal. */
+ int width; /* Desired narrow dimension of scrollbar,
+ * in pixels. */
+ char *command; /* Command prefix to use when invoking
+ * scrolling commands. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int commandSize; /* Number of non-NULL bytes in command. */
+ int repeatDelay; /* How long to wait before auto-repeating
+ * on scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ int jump; /* Value of -jump option. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D borders. */
+ Tk_3DBorder bgBorder; /* Used for drawing background (all flat
+ * surfaces except for trough). */
+ Tk_3DBorder activeBorder; /* For drawing backgrounds when active (i.e.
+ * when mouse is positioned over element). */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ GC troughGC; /* For drawing trough. */
+ GC copyGC; /* Used for copying from pixmap onto screen. */
+ 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. */
+ Tk_TimerToken autoRepeat; /* Token for auto-repeat that's
+ * currently in progress. NULL means no
+ * auto-repeat in progress. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+
+ /*
+ * Mac specific fields.
+ */
+ ControlRef sbHandle; /* Handle to the Scrollbar control struct. */
+} Scrollbar;
+
+/*
+ * 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.
+ * SCROLLBAR_GROW: Non-zero means this window draws the grow
+ * region for the toplevel window. Mac only.
+ * ACTIVE: Non-zero means this window is currently
+ * active (in the foreground). Mac only.
+ */
+
+#define REDRAW_PENDING 1
+#define NEW_STYLE_COMMANDS 2
+#define GOT_FOCUS 4
+#define SCROLLBAR_GROW 8
+#define ACTIVE 16
+
+/*
+ * 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
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_COLOR, Tk_Offset(Scrollbar, activeBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_MONO, Tk_Offset(Scrollbar, activeBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_RELIEF, "-activerelief", "activeRelief", "Relief",
+ DEF_SCROLLBAR_ACTIVE_RELIEF, Tk_Offset(Scrollbar, activeRelief), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_COLOR, Tk_Offset(Scrollbar, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_MONO, Tk_Offset(Scrollbar, 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(Scrollbar, borderWidth), 0},
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_SCROLLBAR_COMMAND, Tk_Offset(Scrollbar, command),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_SCROLLBAR_CURSOR, Tk_Offset(Scrollbar, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-elementborderwidth", "elementBorderWidth",
+ "BorderWidth", DEF_SCROLLBAR_EL_BORDER_WIDTH,
+ Tk_Offset(Scrollbar, elementBorderWidth), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_SCROLLBAR_HIGHLIGHT_BG,
+ Tk_Offset(Scrollbar, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_SCROLLBAR_HIGHLIGHT,
+ Tk_Offset(Scrollbar, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(Scrollbar, highlightWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-jump", "jump", "Jump",
+ DEF_SCROLLBAR_JUMP, Tk_Offset(Scrollbar, jump), 0},
+ {TK_CONFIG_UID, "-orient", "orient", "Orient",
+ DEF_SCROLLBAR_ORIENT, Tk_Offset(Scrollbar, orientUid), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_SCROLLBAR_RELIEF, Tk_Offset(Scrollbar, relief), 0},
+ {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SCROLLBAR_REPEAT_DELAY, Tk_Offset(Scrollbar, repeatDelay), 0},
+ {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SCROLLBAR_REPEAT_INTERVAL, Tk_Offset(Scrollbar, repeatInterval), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_SCROLLBAR_TAKE_FOCUS, Tk_Offset(Scrollbar, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_COLOR, Tk_Offset(Scrollbar, troughColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_MONO, Tk_Offset(Scrollbar, troughColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_SCROLLBAR_WIDTH, Tk_Offset(Scrollbar, width), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ComputeScrollbarGeometry _ANSI_ARGS_((
+ Scrollbar *scrollPtr));
+static int ConfigureScrollbar _ANSI_ARGS_((Tcl_Interp *interp,
+ Scrollbar *scrollPtr, int argc, char **argv,
+ int flags));
+static void DestroyScrollbar _ANSI_ARGS_((char *memPtr));
+static void DisplayScrollbar _ANSI_ARGS_((ClientData clientData));
+static void EventuallyRedraw _ANSI_ARGS_((Scrollbar *scrollPtr));
+static void ScrollbarCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ScrollbarEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ScrollbarPosition _ANSI_ARGS_((Scrollbar *scrollPtr,
+ int x, int y));
+static int ScrollbarWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+static pascal void ScrollbarActionProc _ANSI_ARGS_((ControlRef theControl,
+ ControlPartCode partCode));
+static pascal void ThumbActionProc _ANSI_ARGS_((void));
+
+/*
+ * Globals uses locally in this file.
+ */
+static ControlActionUPP scrollActionProc = NULL; /* Pointer to func. */
+static ThumbActionUPP thumbActionProc = NULL; /* Pointer to func. */
+static Scrollbar *activeScrollPtr = NULL; /* Non-null when in thumb */
+ /* proc. */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MacScrollbarCmd --
+ *
+ * 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_MacScrollbarCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ register Scrollbar *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;
+ }
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScrollbar,
+ * or which ConfigureScrollbar expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ scrollPtr = (Scrollbar *) ckalloc(sizeof(Scrollbar));
+ scrollPtr->tkwin = new;
+ scrollPtr->display = Tk_Display(new);
+ scrollPtr->interp = interp;
+ scrollPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetCmd,
+ (ClientData) scrollPtr, ScrollbarCmdDeletedProc);
+ scrollPtr->orientUid = NULL;
+ scrollPtr->vertical = 0;
+ scrollPtr->width = 0;
+ scrollPtr->command = NULL;
+ scrollPtr->commandSize = 0;
+ scrollPtr->repeatDelay = 0;
+ scrollPtr->repeatInterval = 0;
+ scrollPtr->borderWidth = 0;
+ scrollPtr->bgBorder = NULL;
+ scrollPtr->activeBorder = NULL;
+ scrollPtr->troughColorPtr = NULL;
+ scrollPtr->troughGC = None;
+ scrollPtr->copyGC = None;
+ 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->autoRepeat = NULL;
+ scrollPtr->flags = 0;
+
+ /*
+ * Mac specific inits.
+ */
+ scrollPtr->sbHandle = NULL;
+
+ Tk_SetClass(scrollPtr->tkwin, "MacScrollbar");
+ Tk_CreateEventHandler(scrollPtr->tkwin,
+ ActivateMask|ExposureMask|StructureNotifyMask|FocusChangeMask|ButtonPressMask,
+ ScrollbarEventProc, (ClientData) scrollPtr);
+ if (ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+
+ interp->result = Tk_PathName(scrollPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(scrollPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a widget managed by this module.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScrollbarWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about scrollbar
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Scrollbar *scrollPtr = (Scrollbar *) 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)) {
+ if (argc == 2) {
+ switch (scrollPtr->activeField) {
+ case TOP_ARROW: interp->result = "arrow1"; break;
+ case SLIDER: interp->result = "slider"; break;
+ case BOTTOM_ARROW: interp->result = "arrow2"; break;
+ }
+ goto done;
+ }
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " activate element\"", (char *) NULL);
+ goto error;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ 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;
+ }
+ EventuallyRedraw(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, configSpecs,
+ (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, configSpecs,
+ (char *) scrollPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin, configSpecs,
+ (char *) scrollPtr, argv[2], 0);
+ } else {
+ result = ConfigureScrollbar(interp, scrollPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "delta", length) == 0)) {
+ int xDelta, yDelta, pixels, length;
+ double fraction;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " delta xDelta yDelta\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &xDelta) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &yDelta) != TCL_OK)) {
+ goto error;
+ }
+ if (scrollPtr->vertical) {
+ pixels = yDelta;
+ length = Tk_Height(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ } else {
+ pixels = xDelta;
+ length = Tk_Width(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ }
+ if (length == 0) {
+ fraction = 0.0;
+ } else {
+ fraction = ((double) pixels / (double) length);
+ }
+ sprintf(interp->result, "%g", fraction);
+ } else if ((c == 'f') && (strncmp(argv[1], "fraction", length) == 0)) {
+ int x, y, pos, length;
+ double fraction;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " fraction x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ if (scrollPtr->vertical) {
+ pos = y - (scrollPtr->arrowLength + scrollPtr->inset);
+ length = Tk_Height(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ } else {
+ pos = x - (scrollPtr->arrowLength + scrollPtr->inset);
+ length = Tk_Width(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ }
+ if (length == 0) {
+ fraction = 0.0;
+ } else {
+ fraction = ((double) pos / (double) length);
+ }
+ if (fraction < 0) {
+ fraction = 0;
+ } else if (fraction > 1.0) {
+ fraction = 1.0;
+ }
+ sprintf(interp->result, "%g", fraction);
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " get\"", (char *) NULL);
+ goto error;
+ }
+ if (scrollPtr->flags & NEW_STYLE_COMMANDS) {
+ char first[TCL_DOUBLE_SPACE], last[TCL_DOUBLE_SPACE];
+
+ Tcl_PrintDouble(interp, scrollPtr->firstFraction, first);
+ Tcl_PrintDouble(interp, scrollPtr->lastFraction, last);
+ Tcl_AppendResult(interp, first, " ", last, (char *) NULL);
+ } else {
+ sprintf(interp->result, "%d %d %d %d", scrollPtr->totalUnits,
+ scrollPtr->windowUnits, scrollPtr->firstUnit,
+ scrollPtr->lastUnit);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
+ int x, y, thing;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " identify x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ thing = ScrollbarPosition(scrollPtr, x,y);
+ switch (thing) {
+ case TOP_ARROW: interp->result = "arrow1"; break;
+ case TOP_GAP: interp->result = "trough1"; break;
+ case SLIDER: interp->result = "slider"; break;
+ case BOTTOM_GAP: interp->result = "trough2"; break;
+ case BOTTOM_ARROW: interp->result = "arrow2"; break;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)) {
+ int totalUnits, windowUnits, firstUnit, lastUnit;
+
+ if (argc == 4) {
+ double first, last;
+
+ if (Tcl_GetDouble(interp, argv[2], &first) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetDouble(interp, argv[3], &last) != TCL_OK) {
+ goto error;
+ }
+ if (first < 0) {
+ scrollPtr->firstFraction = 0;
+ } else if (first > 1.0) {
+ scrollPtr->firstFraction = 1.0;
+ } else {
+ scrollPtr->firstFraction = first;
+ }
+ if (last < scrollPtr->firstFraction) {
+ scrollPtr->lastFraction = scrollPtr->firstFraction;
+ } else if (last > 1.0) {
+ scrollPtr->lastFraction = 1.0;
+ } else {
+ scrollPtr->lastFraction = last;
+ }
+ scrollPtr->flags |= NEW_STYLE_COMMANDS;
+ } else if (argc == 6) {
+ if (Tcl_GetInt(interp, argv[2], &totalUnits) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits < 0) {
+ totalUnits = 0;
+ }
+ if (Tcl_GetInt(interp, argv[3], &windowUnits) != TCL_OK) {
+ goto error;
+ }
+ if (windowUnits < 0) {
+ windowUnits = 0;
+ }
+ if (Tcl_GetInt(interp, argv[4], &firstUnit) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[5], &lastUnit) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits > 0) {
+ if (lastUnit < firstUnit) {
+ lastUnit = firstUnit;
+ }
+ } else {
+ firstUnit = lastUnit = 0;
+ }
+ scrollPtr->totalUnits = totalUnits;
+ scrollPtr->windowUnits = windowUnits;
+ scrollPtr->firstUnit = firstUnit;
+ scrollPtr->lastUnit = lastUnit;
+ if (scrollPtr->totalUnits == 0) {
+ scrollPtr->firstFraction = 0.0;
+ scrollPtr->lastFraction = 1.0;
+ } else {
+ scrollPtr->firstFraction = ((double) firstUnit)/totalUnits;
+ scrollPtr->lastFraction = ((double) (lastUnit+1))/totalUnits;
+ }
+ scrollPtr->flags &= ~NEW_STYLE_COMMANDS;
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " set firstFraction lastFraction\" or \"",
+ argv[0],
+ " set totalUnits windowUnits firstUnit lastUnit\"",
+ (char *) NULL);
+ goto error;
+ }
+ ComputeScrollbarGeometry(scrollPtr);
+ EventuallyRedraw(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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyScrollbar --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a scrollbar at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the scrollbar is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyScrollbar(memPtr)
+ char *memPtr; /* Info about scrollbar widget. */
+{
+ register Scrollbar *scrollPtr = (Scrollbar *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ /*
+ * Free Macintosh control.
+ */
+ if (scrollPtr->sbHandle != NULL) {
+ DisposeControl(scrollPtr->sbHandle);
+ scrollPtr->sbHandle = NULL;
+ }
+
+ if (scrollPtr->troughGC != None) {
+ Tk_FreeGC(scrollPtr->display, scrollPtr->troughGC);
+ }
+ if (scrollPtr->copyGC != None) {
+ Tk_FreeGC(scrollPtr->display, scrollPtr->copyGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) scrollPtr, scrollPtr->display, 0);
+ ckfree((char *) scrollPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScrollbar --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or
+ * reconfigure) a scrollbar widget.
+ *
+ * Results:
+ * The return value is a standard Tcl result. If TCL_ERROR is
+ * returned, then interp->result contains an error message.
+ *
+ * Side effects:
+ * Configuration information, such as colors, border width,
+ * etc. get set for scrollPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScrollbar(interp, scrollPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Scrollbar *scrollPtr; /* Information about widget; may or
+ * may not already have values for
+ * some fields. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ size_t length;
+ XGCValues gcValues;
+ GC new;
+
+ if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, configSpecs,
+ argc, argv, (char *) scrollPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as parsing the
+ * orientation or setting the background from a 3-D border.
+ */
+
+ length = strlen(scrollPtr->orientUid);
+ if (strncmp(scrollPtr->orientUid, "vertical", length) == 0) {
+ scrollPtr->vertical = 1;
+ } else if (strncmp(scrollPtr->orientUid, "horizontal", length) == 0) {
+ scrollPtr->vertical = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad orientation \"", scrollPtr->orientUid,
+ "\": must be vertical or horizontal", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (scrollPtr->command != NULL) {
+ scrollPtr->commandSize = strlen(scrollPtr->command);
+ } else {
+ scrollPtr->commandSize = 0;
+ }
+
+ Tk_SetBackgroundFromBorder(scrollPtr->tkwin, scrollPtr->bgBorder);
+
+ gcValues.foreground = scrollPtr->troughColorPtr->pixel;
+ new = Tk_GetGC(scrollPtr->tkwin, GCForeground, &gcValues);
+ if (scrollPtr->troughGC != None) {
+ Tk_FreeGC(scrollPtr->display, scrollPtr->troughGC);
+ }
+ scrollPtr->troughGC = new;
+ if (scrollPtr->copyGC == None) {
+ gcValues.graphics_exposures = False;
+ scrollPtr->copyGC = Tk_GetGC(scrollPtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ }
+
+ /*
+ * 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.
+ */
+
+ ComputeScrollbarGeometry(scrollPtr);
+ EventuallyRedraw(scrollPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayScrollbar --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayScrollbar(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register Scrollbar *scrollPtr = (Scrollbar *) clientData;
+ register Tk_Window tkwin = scrollPtr->tkwin;
+
+ MacDrawable *macDraw;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ double middle;
+ WindowRef windowRef;
+ int drawGrowRgn = false;
+ int flushRight = false;
+ int flushBottom = false;
+
+ if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Draw the focus or any 3D relief we may have.
+ */
+ if (scrollPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (scrollPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(scrollPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, scrollPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scrollPtr->bgBorder,
+ scrollPtr->highlightWidth, scrollPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scrollPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scrollPtr->highlightWidth,
+ scrollPtr->borderWidth, scrollPtr->relief);
+
+ /*
+ * Set up port for drawing Macintosh control.
+ */
+ macDraw = (MacDrawable *) Tk_WindowId(tkwin);
+ destPort = TkMacGetDrawablePort(Tk_WindowId(tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ /*
+ * 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));
+
+ if (scrollPtr->sbHandle == NULL) {
+ Rect r;
+
+ r.left = r.top = 0;
+ r.right = r.bottom = 1;
+ scrollPtr->sbHandle = NewControl((WindowRef) destPort, &r, "\p",
+ false, (short) (middle * 1000), 0, 1000,
+ scrollBarProc, (SInt32) scrollPtr);
+
+ /*
+ * If we are foremost than make us active.
+ */
+ if ((WindowPtr) destPort == FrontWindow()) {
+ scrollPtr->flags |= ACTIVE;
+ }
+ }
+ windowRef = (**scrollPtr->sbHandle).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.
+ */
+
+ (**scrollPtr->sbHandle).contrlRect.left = macDraw->xOff + scrollPtr->inset;
+ (**scrollPtr->sbHandle).contrlRect.top = macDraw->yOff + scrollPtr->inset;
+ (**scrollPtr->sbHandle).contrlRect.right = macDraw->xOff + Tk_Width(tkwin)
+ - scrollPtr->inset;
+ (**scrollPtr->sbHandle).contrlRect.bottom = macDraw->yOff +
+ Tk_Height(tkwin) - scrollPtr->inset;
+
+ /*
+ * Here is a lovely hack to draw the grow region of a window.
+ */
+ /* TODO: use accessor function!!! */
+ if (windowRef->portRect.top == (**scrollPtr->sbHandle).contrlRect.top) {
+ (**scrollPtr->sbHandle).contrlRect.top--;
+ }
+
+ if (windowRef->portRect.left == (**scrollPtr->sbHandle).contrlRect.left) {
+ (**scrollPtr->sbHandle).contrlRect.left--;
+ }
+
+ if (windowRef->portRect.right == (**scrollPtr->sbHandle).contrlRect.right) {
+ flushRight = true;
+ (**scrollPtr->sbHandle).contrlRect.right++;
+ }
+
+ if (windowRef->portRect.bottom == (**scrollPtr->sbHandle).contrlRect.bottom) {
+ flushBottom = true;
+ (**scrollPtr->sbHandle).contrlRect.bottom++;
+ }
+
+ if (flushBottom && flushRight) {
+ if (scrollPtr->vertical) {
+ (**scrollPtr->sbHandle).contrlRect.bottom -= 14;
+ } else {
+ (**scrollPtr->sbHandle).contrlRect.right -= 14;
+ }
+ drawGrowRgn = true;
+ TkMacSetScrollbarGrow((TkWindow *) tkwin, true);
+ } else {
+ TkMacSetScrollbarGrow((TkWindow *) tkwin, false);
+ }
+
+ /*
+ * Set the thumb position in the scrollbar.
+ */
+ (**scrollPtr->sbHandle).contrlValue = (short) (middle * 1000);
+ if ((**scrollPtr->sbHandle).contrlHilite == 0 ||
+ (**scrollPtr->sbHandle).contrlHilite == 255) {
+ if (scrollPtr->firstFraction == 0.0 &&
+ scrollPtr->lastFraction == 1.0) {
+ (**scrollPtr->sbHandle).contrlHilite = 255;
+ } else {
+ (**scrollPtr->sbHandle).contrlHilite = 0;
+ }
+ }
+ if ((**scrollPtr->sbHandle).contrlVis != 255) {
+ (**scrollPtr->sbHandle).contrlVis = 255;
+ }
+
+ if (scrollPtr->flags & ACTIVE) {
+ Draw1Control(scrollPtr->sbHandle);
+ if (drawGrowRgn) {
+ DrawGrowIcon(windowRef);
+ }
+ } else {
+ (**scrollPtr->sbHandle).contrlHilite = 255;
+ Draw1Control(scrollPtr->sbHandle);
+ if (drawGrowRgn) {
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Scrollbar *scrollPtr = (Scrollbar *) clientData;
+ Tcl_Interp *interp;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ EventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == DestroyNotify) {
+ if (scrollPtr->tkwin != NULL) {
+ scrollPtr->tkwin = NULL;
+ Tcl_DeleteCommand(scrollPtr->interp,
+ Tcl_GetCommandName(scrollPtr->interp,
+ scrollPtr->widgetCmd));
+ }
+ if (scrollPtr->flags & REDRAW_PENDING) {
+ Tk_CancelIdleCall(DisplayScrollbar, (ClientData) scrollPtr);
+ }
+ Tcl_EventuallyFree((ClientData) scrollPtr, DestroyScrollbar);
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeScrollbarGeometry(scrollPtr);
+ EventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags |= GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ EventuallyRedraw(scrollPtr);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags &= ~GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ EventuallyRedraw(scrollPtr);
+ }
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ TkMacSetScrollbarGrow((TkWindow *) scrollPtr->tkwin, false);
+ } else if (eventPtr->type == ActivateNotify) {
+ scrollPtr->flags |= ACTIVE;
+ EventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == DeactivateNotify) {
+ scrollPtr->flags &= ~ACTIVE;
+ EventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == ButtonPress) {
+ 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(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(scrollPtr->sbHandle, where);
+ if (part == inThumb && scrollPtr->jump == false) {
+ /*
+ * Case 1: In thumb, no jump scrolling. Call track control
+ * with the thumb action proc which will do most of the work.
+ * Set the global activeScrollPtr to the current control
+ * so the callback may have access to it.
+ */
+ if (thumbActionProc == NULL) {
+ thumbActionProc = NewThumbActionProc(ThumbActionProc);
+ }
+ activeScrollPtr = scrollPtr;
+ part = TrackControl(scrollPtr->sbHandle, where,
+ (ControlActionUPP) thumbActionProc);
+ activeScrollPtr = NULL;
+ } else if (part == inThumb) {
+ /*
+ * Case 2: in thumb with jump scrolling. Call TrackControl
+ * with a NULL action proc. Use the new value of the control
+ * to set update the control.
+ */
+ part = TrackControl(scrollPtr->sbHandle, where, NULL);
+ if (part == inThumb) {
+ double newFirstFraction, thumbWidth;
+ Tcl_DString cmdString;
+ char vauleString[TCL_DOUBLE_SPACE];
+
+ /*
+ * The following calculation takes the new control
+ * value and maps it to what Tk needs for its variable
+ * thumb size representation.
+ */
+ thumbWidth = scrollPtr->lastFraction
+ - scrollPtr->firstFraction;
+ newFirstFraction = (1.0 - thumbWidth) *
+ ((double) GetControlValue(scrollPtr->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.
+ */
+ if (scrollActionProc == NULL) {
+ scrollActionProc = NewControlActionProc(ScrollbarActionProc);
+ }
+ TrackControl(scrollPtr->sbHandle, where, scrollActionProc);
+ HiliteControl(scrollPtr->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, &dummyWin, &dummyWin, &x,
+ &y, &dummy, &dummy, &state);
+ TkGenerateButtonEvent(x, y, state);
+
+ SetGWorld(saveWorld, saveDevice);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ Scrollbar *scrollPtr = (Scrollbar *) 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeScrollbarGeometry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeScrollbarGeometry(scrollPtr)
+ register Scrollbar *scrollPtr; /* Scrollbar whose geometry may
+ * have changed. */
+{
+ int width, fieldLength;
+
+/* TODO: this should be Mac specific */
+
+ 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarPosition --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScrollbarPosition(scrollPtr, x, y)
+ register Scrollbar *scrollPtr; /* Scrollbar widget record. */
+ int x, y; /* Coordinates within scrollPtr's
+ * window. */
+{
+ int length, width, tmp;
+ 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.
+ */
+
+ TkMacWinBounds((TkWindow *) scrollPtr->tkwin, &bounds);
+ where.h = x + bounds.left;
+ where.v = y + bounds.top;
+ part = TestControl(scrollPtr->sbHandle, where);
+ switch (part) {
+ case inUpButton:
+ return TOP_ARROW;
+ case inPageUp:
+ return TOP_GAP;
+ case inThumb:
+ return SLIDER;
+ case inPageDown:
+ return BOTTOM_GAP;
+ case inDownButton:
+ return BOTTOM_ARROW;
+ default:
+ return OUTSIDE;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EventuallyRedraw --
+ *
+ * Arrange for one or more of the fields of a scrollbar
+ * to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EventuallyRedraw(scrollPtr)
+ register Scrollbar *scrollPtr; /* Information about widget. */
+{
+ if ((scrollPtr->tkwin == NULL) || (!Tk_IsMapped(scrollPtr->tkwin))) {
+ return;
+ }
+ if ((scrollPtr->flags & REDRAW_PENDING) == 0) {
+ Tk_DoWhenIdle(DisplayScrollbar, (ClientData) scrollPtr);
+ scrollPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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, ControlPartCode partCode)
+ /* ControlRef theControl; /* Handle to scrollbat control */
+ /* ControlPartCode partCode; /* Part of scrollbar that was "hit" */
+{
+ register Scrollbar *scrollPtr = (Scrollbar *) GetCRefCon(theControl);
+ Tcl_DString cmdString;
+ Tcl_Interp *interp;
+
+ Tcl_DStringInit(&cmdString);
+ switch (partCode) {
+ case inPageUp:
+ case inPageDown:
+ case inDownButton:
+ case inUpButton:
+ if (partCode == inPageUp || partCode == inPageDown) {
+ Tcl_DStringAppendElement(&cmdString, "tkScrollByPages");
+ } else {
+ Tcl_DStringAppendElement(&cmdString, "tkScrollByUnits");
+ }
+ Tcl_DStringAppendElement(&cmdString,
+ Tk_PathName(scrollPtr->tkwin));
+ Tcl_DStringAppendElement(&cmdString, "hv");
+ if (partCode == inPageUp || partCode == inUpButton) {
+ Tcl_DStringAppendElement(&cmdString, "-1");
+ } else {
+ Tcl_DStringAppendElement(&cmdString, "1");
+ }
+ Tcl_DStringAppend(&cmdString, "; update idletasks",
+ strlen("; update idletasks"));
+ interp = scrollPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ Tcl_GlobalEval(interp, cmdString.string);
+ Tcl_Release((ClientData) interp);
+ break;
+ }
+ Tcl_DStringFree(&cmdString);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 Scrollbar *scrollPtr = 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(scrollPtr->sbHandle);
+ trackRect = (**scrollPtr->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,
+ 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);
+ }
+
+ /*
+ * 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;
+}
diff --git a/tk/mac/tkMacSend.c b/tk/mac/tkMacSend.c
index 262cc1463f2..611436ee041 100644
--- a/tk/mac/tkMacSend.c
+++ b/tk/mac/tkMacSend.c
@@ -6,8 +6,27 @@
* 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-1996 Sun Microsystems, Inc.
+ * 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.
@@ -15,9 +34,13 @@
* 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.
@@ -27,17 +50,12 @@ typedef struct RegisteredInterp {
char *name; /* Interpreter's name (malloc-ed). */
Tcl_Interp *interp; /* Interpreter associated with
* name. */
- TkWindow *winPtr; /* Main window for the application. */
struct RegisteredInterp *nextPtr;
/* Next in list of names associated
* with interps in this process.
* NULL means end of list. */
} RegisteredInterp;
-static RegisteredInterp *registry = NULL;
-/* List of all interpreters
- * registered by this process. */
-
/*
* A registry of all interpreters for a display is kept in a
* property "InterpRegistry" on the root window of the display.
@@ -61,54 +79,19 @@ typedef struct NameRegistry {
* been modified, so it needs to be written
* out when the NameRegistry is closed. */
unsigned long propLength; /* Length of the property, in bytes. */
- char *property; /* The contents of the property. See format
- * above; this is *not* terminated by the
- * first null character. Dynamically
- * allocated. */
+ 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.
- */
+static initialized = false; /* A flag to denote if we have initialized yet. */
-typedef struct PendingCommand {
- int serial; /* Serial number expected in
- * result. */
- TkDisplay *dispPtr; /* Display being used for communication. */
- char *target; /* Name of interpreter command is
- * being sent to. */
- Window commWindow; /* Target's communication window. */
- Tk_TimerToken timeout; /* Token for timer handler used to check
- * up on target during long sends. */
- Tcl_Interp *interp; /* Interpreter from which the send
- * was invoked. */
- int code; /* Tcl return code for command
- * will be stored here. */
- char *result; /* String result for command (malloc'ed),
- * or NULL. */
- char *errorInfo; /* Information for "errorInfo" variable,
- * or NULL (malloc'ed). */
- char *errorCode; /* Information for "errorCode" variable,
- * or NULL (malloc'ed). */
- int gotResponse; /* 1 means a response has been received,
- * 0 means the command is still outstanding. */
- struct PendingCommand *nextPtr;
- /* Next in list of all outstanding
- * commands. NULL means end of
- * list. */
-} PendingCommand;
-
-static PendingCommand *pendingCommands = NULL;
-/* List of all commands currently
- * being waited for. */
+static RegisteredInterp *interpListPtr = NULL;
+/* List of all interpreters
+ * registered by this process. */
/*
* The information below is used for communication between processes
@@ -206,9 +189,6 @@ int tkSendSerial = 0;
static int AppendErrorProc _ANSI_ARGS_((ClientData clientData,
XErrorEvent *errorPtr));
-static void AppendPropCarefully _ANSI_ARGS_((Display *display,
- Window window, Atom property, char *value,
- int length, PendingCommand *pendingPtr));
static void DeleteProc _ANSI_ARGS_((ClientData clientData));
static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
char *name, Window commWindow));
@@ -221,8 +201,7 @@ static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
TkWindow *winPtr, int lock));
static void SendEventProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
-static int SendInit _ANSI_ARGS_((Tcl_Interp *interp,
- TkWindow *winPtr));
+static 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));
@@ -265,13 +244,103 @@ Tk_SetAppName(
* "send" commands. Must be globally
* unique. */
{
- return name;
+ 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_SendCmd --
+ * Tk_SendObjCmd --
*
* This procedure is invoked to process the "send" Tcl command.
* See the user documentation for details on what it does.
@@ -286,15 +355,127 @@ Tk_SetAppName(
*/
int
-Tk_SendCmd(
- ClientData clientData, /* Information about sender (only
- * dispPtr field is used). */
- Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+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 */
{
- Tcl_SetResult(interp, "Send not yet implemented", TCL_STATIC);
- return TCL_ERROR;
+ static char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL};
+ char *stringRep, *destName;
+ int async = 0;
+ int i, index, firstArg;
+ RegisteredInterp *riPtr;
+ Tcl_Obj *resultPtr, *listObjPtr;
+ int result;
+
+ for (i = 1; i < (objc - 1); ) {
+ stringRep = Tcl_GetStringFromObj(objv[i], NULL);
+ if (stringRep[0] == '-') {
+ if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index == 0) {
+ async = 1;
+ i++;
+ } else if (index == 1) {
+ i += 2;
+ } else {
+ i++;
+ }
+ } else {
+ break;
+ }
+ }
+
+ if (objc < (i + 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?options? interpName arg ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ destName = Tcl_GetStringFromObj(objv[i], NULL);
+ firstArg = i + 1;
+
+ resultPtr = Tcl_GetObjResult(interp);
+
+ /*
+ * See if the target interpreter is local. If so, execute
+ * the command directly without going through the DDE server.
+ * The only tricky thing is passing the result from the target
+ * interpreter to the invoking interpreter. Watch out: they
+ * could be the same!
+ */
+
+ for (riPtr = interpListPtr; (riPtr != NULL)
+ && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ if (riPtr != NULL) {
+ /*
+ * This command is to a local interp. No need to go through
+ * the server.
+ */
+
+ Tcl_Interp *localInterp;
+
+ Tcl_Preserve((ClientData) riPtr);
+ localInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) localInterp);
+ if (firstArg == (objc - 1)) {
+ /*
+ * This might be one of those cases where the new
+ * parser is faster.
+ */
+
+ result = Tcl_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;
}
/*
@@ -324,8 +505,19 @@ TkGetInterpNames(
Tk_Window tkwin) /* Window whose display is to be used
* for the lookup. */
{
- Tcl_SetResult(interp, "Send not yet implemented", TCL_STATIC);
- return TCL_ERROR;
+ 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;
}
/*
@@ -348,11 +540,10 @@ TkGetInterpNames(
static int
SendInit(
- Tcl_Interp *interp, /* Interpreter to use for error reporting
+ Tcl_Interp *interp) /* Interpreter to use for error reporting
* (no errors are ever returned, but the
* interpreter is needed anyway). */
- TkWindow *winPtr) /* Window that identifies the display to
- * initialize. */
{
return TCL_OK;
}
+
diff --git a/tk/mac/tkMacShLib.exp b/tk/mac/tkMacShLib.exp
index 20e5bf33dcd..e6b4aa5b248 100644
--- a/tk/mac/tkMacShLib.exp
+++ b/tk/mac/tkMacShLib.exp
@@ -84,7 +84,6 @@ TkGetMenuHashTable
TkGetMenuIndex
TkGetMiterPoints
TkGetPointerCoords
-TkGetProlog
TkGetServerInfo
TkGetTransientMaster
TkGrabDeadWindow
@@ -545,7 +544,7 @@ XChangeWindowAttributes
XConfigureWindow
XCopyArea
XCopyPlane
-XCreateBitmapFromData
+TkCreateBitmapFromData
XCreateColormap
XCreateGC
XCreateImage
@@ -584,7 +583,7 @@ XMoveWindow
XParseColor
XQueryPointer
XRaiseWindow
-XReadBitmapFile
+TkReadBitmapFile
XRefreshKeyboardMapping
XResizeWindow
XRootWindow
diff --git a/tk/mac/tkMacSubwindows.c b/tk/mac/tkMacSubwindows.c
index 98adbd89186..e422ca82d79 100644
--- a/tk/mac/tkMacSubwindows.c
+++ b/tk/mac/tkMacSubwindows.c
@@ -930,14 +930,23 @@ TkMacGetDrawablePort(
contWinPtr = TkpGetOtherWindow(macWin->toplevel->winPtr);
if (contWinPtr != NULL) {
- resultPort = TkMacGetDrawablePort((Drawable) contWinPtr->privatePtr);
+ resultPort = TkMacGetDrawablePort(
+ (Drawable) contWinPtr->privatePtr);
} else if (gMacEmbedHandler != NULL) {
resultPort = gMacEmbedHandler->getPortProc(
(Tk_Window) macWin->winPtr);
}
if (resultPort == NULL) {
- panic("TkMacGetDrawablePort couldn't find container");
+ /*
+ * 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;
}
@@ -1074,10 +1083,14 @@ tkMacMoveWindow(
{
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);
}
+}
/*
*----------------------------------------------------------------------
@@ -1243,3 +1256,4 @@ Tk_FreePixmap(
ckfree((char *) macPix);
}
+
diff --git a/tk/mac/tkMacTest.c b/tk/mac/tkMacTest.c
index 6d23c6eca68..5ab1b5f12b3 100644
--- a/tk/mac/tkMacTest.c
+++ b/tk/mac/tkMacTest.c
@@ -13,6 +13,7 @@
*/
#include <Types.h>
+#include <tcl.h>
/*
* Forward declarations of procedures defined later in this file:
@@ -79,3 +80,4 @@ DebuggerCmd(
Debugger();
return TCL_OK;
}
+
diff --git a/tk/mac/tkMacWindowMgr.c b/tk/mac/tkMacWindowMgr.c
index af12dacad00..58cd4a7ec7d 100644
--- a/tk/mac/tkMacWindowMgr.c
+++ b/tk/mac/tkMacWindowMgr.c
@@ -3,7 +3,7 @@
*
* Implements common window manager functions for the Macintosh.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * 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.
@@ -63,7 +63,7 @@ static int GenerateActivateEvents _ANSI_ARGS_((EventRecord *eventPtr,
static int GenerateFocusEvent _ANSI_ARGS_((EventRecord *eventPtr,
Window window));
static int GenerateKeyEvent _ANSI_ARGS_((EventRecord *eventPtr,
- Window window));
+ Window window, UInt32 savedCode));
static int GenerateUpdateEvent _ANSI_ARGS_((EventRecord *eventPtr,
Window window));
static void GenerateUpdates _ANSI_ARGS_((RgnHandle updateRgn,
@@ -99,13 +99,19 @@ WindowManagerMouse(
EventRecord *eventPtr, /* Macintosh event record. */
Window window) /* Window pointer. */
{
- WindowRef whichWindow, frontWindow;
+ 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
@@ -122,13 +128,14 @@ WindowManagerMouse(
}
windowPart = FindWindow(eventPtr->where, &whichWindow);
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
switch (windowPart) {
case inSysWindow:
SystemClick(eventPtr, (GrafPort *) whichWindow);
return false;
case inDrag:
- if (whichWindow != frontWindow) {
+ if (!(TkpIsWindowFloating(whichWindow)) && (whichWindow != frontNonFloating)) {
if (!(eventPtr->modifiers & cmdKey)) {
if ((gGrabWinPtr != NULL) && (gGrabWinPtr != tkwin)) {
SysBeep(1);
@@ -162,7 +169,8 @@ WindowManagerMouse(
return true;
case inGrow:
case inContent:
- if (whichWindow != frontWindow ) {
+ 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
@@ -172,9 +180,9 @@ WindowManagerMouse(
SysBeep(1);
return false;
}
- BringWindowForward(whichWindow);
gEatButtonUp = true;
SetPort((GrafPort *) whichWindow);
+ BringWindowForward(whichWindow);
return false;
} else {
/*
@@ -209,6 +217,10 @@ WindowManagerMouse(
GetKeys(theKeys);
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
TkMacClearMenubarActive();
+ /*
+ * Handle -postcommand
+ */
+ TkMacPreprocessMenu();
TkMacHandleMenuSelect(MenuSelect(eventPtr->where),
theKeys[1] & 4);
Tcl_SetServiceMode(oldMode);
@@ -264,7 +276,11 @@ TkAboutDlg()
DisposDialog(aboutDlog);
aboutDlog = NULL;
+ if (TkMacHaveAppearance() >= 0x110) {
SelectWindow(FrontWindow());
+ } else {
+ SelectWindow(FrontNonFloatingWindow());
+ }
return;
}
@@ -293,8 +309,10 @@ GenerateUpdateEvent(
{
WindowRef macWindow;
register TkWindow *winPtr;
+ TkDisplay *dispPtr;
- winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
if (winPtr == NULL) {
return false;
@@ -464,6 +482,7 @@ TkGenerateButtonEvent(
Point where;
Tk_Window tkwin;
int dummy;
+ TkDisplay *dispPtr;
/*
* ButtonDown events will always occur in the front
@@ -474,13 +493,19 @@ TkGenerateButtonEvent(
where.h = x;
where.v = y;
FindWindow(where, &whichWin);
- frontWin = FrontWindow();
-
- if ((frontWin == NULL) || (frontWin != whichWin && gGrabWinPtr == NULL)) {
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontWin = FrontNonFloatingWindow();
+ } else {
+ frontWin = FrontWindow();
+ }
+
+ if ((frontWin == NULL) || ((!(TkpIsWindowFloating(whichWin)) && (frontWin != whichWin))
+ && gGrabWinPtr == NULL)) {
return false;
}
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
GlobalToLocal(&where);
if (tkwin != NULL) {
@@ -517,8 +542,10 @@ GenerateActivateEvents(
Window window) /* Root X window for event. */
{
TkWindow *winPtr;
+ TkDisplay *dispPtr;
- winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
if (winPtr == NULL || winPtr->window == None) {
return false;
}
@@ -629,8 +656,10 @@ GenerateFocusEvent(
{
XEvent event;
Tk_Window tkwin;
+ TkDisplay *dispPtr;
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
if (tkwin == NULL) {
return false;
}
@@ -646,9 +675,9 @@ GenerateFocusEvent(
event.xany.type = FocusOut;
}
- event.xany.serial = tkDisplayList->display->request;
+ event.xany.serial = dispPtr->display->request;
event.xany.send_event = False;
- event.xfocus.display = tkDisplayList->display;
+ event.xfocus.display = dispPtr->display;
event.xfocus.window = window;
event.xfocus.mode = NotifyNormal;
event.xfocus.detail = NotifyDetailNone;
@@ -679,23 +708,46 @@ GenerateFocusEvent(
static int
GenerateKeyEvent(
EventRecord *eventPtr, /* Incoming Mac event */
- Window window) /* Root X window for 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.
*/
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ 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;
@@ -710,7 +762,10 @@ GenerateKeyEvent(
GlobalToLocal(&where);
Tk_TopCoordsToWindow(tkwin, where.h, where.v,
&event.xkey.x, &event.xkey.y);
- event.xkey.keycode = eventPtr->message;
+
+ event.xkey.keycode = byte |
+ ((savedKeyCode & charCodeMask) << 8) |
+ ((eventPtr->message & keyCodeMask) << 8);
event.xany.serial = Tk_Display(tkwin)->request;
event.xkey.window = Tk_WindowId(tkwin);
@@ -764,13 +819,14 @@ GeneratePollingEvents()
{
Tk_Window tkwin, rootwin;
Window window;
- WindowRef whichwindow, frontWin;
+ 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).
@@ -785,14 +841,33 @@ GeneratePollingEvents()
whereGlobal = whereLocal;
LocalToGlobal(&whereGlobal);
- part = FindWindow(whereGlobal, &whichwindow);
+ part = FindWindow(whereGlobal, &whichWindow);
inContentRgn = (part == inContent || part == inGrow);
- if ((frontWin != whichwindow) || !inContentRgn) {
+ 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);
- rootwin = Tk_IdToWindow(tkDisplayList->display, window);
+ window = TkMacGetXWindow(whichWindow);
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
if (rootwin == NULL) {
tkwin = NULL;
} else {
@@ -859,6 +934,7 @@ GeneratePollingEvents2(
int local_x, local_y;
int generatedEvents = false;
Rect bounds;
+ TkDisplay *dispPtr;
/*
* First we get the current mouse position and determine
@@ -881,7 +957,8 @@ GeneratePollingEvents2(
if (whichwindow != frontWin) {
tkwin = NULL;
} else {
- rootwin = Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ rootwin = Tk_IdToWindow(dispPtr->display, window);
TkMacWinBounds((TkWindow *) rootwin, &bounds);
if (!PtInRect(whereLocal, &bounds)) {
tkwin = NULL;
@@ -1110,6 +1187,7 @@ TkMacConvertEvent(
WindowRef whichWindow;
Window window;
int eventFound = false;
+ static UInt32 savedKeyCode;
switch (eventPtr->what) {
case nullEvent:
@@ -1153,11 +1231,28 @@ TkMacConvertEvent(
break;
}
}
+ /* fall through */
+
case keyUp:
- whichWindow = FrontWindow();
+ whichWindow = FrontNonFloatingWindow();
+ 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);
- eventFound |= GenerateKeyEvent(eventPtr, window);
+ 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);
@@ -1192,6 +1287,13 @@ TkMacConvertEvent(
TkSuspendClipboard();
}
tkMacAppInFront = (eventPtr->message & resumeFlag);
+ if (TkMacHaveAppearance() >= 0x110) {
+ if (tkMacAppInFront) {
+ ShowFloatingWindows();
+ } else {
+ HideFloatingWindows();
+ }
+ }
break;
}
break;
@@ -1210,6 +1312,7 @@ TkMacConvertEvent(
break;
}
+ savedKeyCode = 0;
return eventFound;
}
@@ -1237,6 +1340,7 @@ TkMacConvertTkEvent(
{
int eventFound = false;
Point where;
+ static UInt32 savedKeyCode;
/*
* By default, assume it is legal for us to set the cursor
@@ -1292,9 +1396,16 @@ TkMacConvertTkEvent(
break;
}
}
+ /* fall through. */
+
case keyUp:
- eventFound |= GenerateKeyEvent(eventPtr, window);
+ 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
@@ -1341,6 +1452,13 @@ TkMacConvertTkEvent(
TkSuspendClipboard();
}
tkMacAppInFront = (eventPtr->message & resumeFlag);
+ if (TkMacHaveAppearance() >= 0x110) {
+ if (tkMacAppInFront) {
+ ShowFloatingWindows();
+ } else {
+ HideFloatingWindows();
+ }
+ }
break;
}
break;
@@ -1358,7 +1476,7 @@ TkMacConvertTkEvent(
}
break;
}
-
+ savedKeyCode = 0;
return eventFound;
}
@@ -1475,6 +1593,12 @@ TkMacWindowOffset(
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);
@@ -1590,7 +1714,10 @@ static void
BringWindowForward(
WindowRef wRef)
{
- SelectWindow(wRef);
+ if (!TkpIsWindowFloating(wRef)) {
+ if (IsValidWindowPtr(wRef))
+ SelectWindow(wRef);
+ }
}
/*
@@ -1628,3 +1755,35 @@ TkpGetMS()
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/tk/mac/tkMacWm.c b/tk/mac/tkMacWm.c
index 033b0d72855..888f02945c8 100644
--- a/tk/mac/tkMacWm.c
+++ b/tk/mac/tkMacWm.c
@@ -205,6 +205,8 @@ typedef struct TkWmInfo {
* Macintosh information.
*/
int style; /* Native window style. */
+ int macClass;
+ int attributes;
TkWindow *scrollWinPtr; /* Ptr to scrollbar handling grow widget. */
} WmInfo;
@@ -402,7 +404,13 @@ TkWmNewWindow(
wmPtr->cmdArgv = NULL;
wmPtr->clientMachine = NULL;
wmPtr->flags = WM_NEVER_MAPPED;
- wmPtr->style = zoomDocProc;
+ if (TkMacHaveAppearance() >= 0x110) {
+ wmPtr->style = -1;
+ } else {
+ wmPtr->style = documentProc;
+ }
+ wmPtr->macClass = kDocumentWindowClass;
+ wmPtr->attributes = kWindowStandardDocumentAttributes;
wmPtr->scrollWinPtr = NULL;
winPtr->wmInfoPtr = wmPtr;
@@ -709,7 +717,7 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 2) {
- interp->result = (wmTracing) ? "on" : "off";
+ Tcl_SetResult(interp, ((wmTracing) ? "on" : "off"), TCL_STATIC);
return TCL_OK;
}
return Tcl_GetBoolean(interp, argv[2], &wmTracing);
@@ -739,9 +747,12 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
+ 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;
}
@@ -756,7 +767,8 @@ Tk_WmCmd(
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- interp->result = "aspect number can't be <= 0";
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -777,7 +789,7 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->clientMachine != NULL) {
- interp->result = wmPtr->clientMachine;
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
}
return TCL_OK;
}
@@ -798,7 +810,7 @@ Tk_WmCmd(
&& (length >= 3)) {
TkWindow **cmapList;
TkWindow *winPtr2;
- int i, windowArgc, gotToplevel;
+ int i, windowArgc, gotToplevel = 0;
char **windowArgv;
if ((argc != 3) && (argc != 4)) {
@@ -875,8 +887,9 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->cmdArgv != NULL) {
- interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- interp->freeProc = (Tcl_FreeProc *) free;
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
}
return TCL_OK;
}
@@ -926,7 +939,8 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = wmPtr->hints.input ? "passive" : "active";
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
return TCL_OK;
}
c = argv[3][0];
@@ -943,6 +957,7 @@ Tk_WmCmd(
} else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
&& (length >= 2)) {
Window window;
+ char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
@@ -953,7 +968,8 @@ Tk_WmCmd(
if (window == None) {
window = Tk_WindowId((Tk_Window) winPtr);
}
- sprintf(interp->result, "0x%x", (unsigned int) window);
+ sprintf(buf, "0x%x", (unsigned int) window);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
&& (length >= 2)) {
char xSign, ySign;
@@ -966,6 +982,8 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
if (wmPtr->gridWin != NULL) {
@@ -977,8 +995,9 @@ Tk_WmCmd(
width = winPtr->changes.width;
height = winPtr->changes.height;
}
- sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
- xSign, wmPtr->x, ySign, wmPtr->y);
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if (*argv[3] == '\0') {
@@ -999,9 +1018,12 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
+ 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;
}
@@ -1028,19 +1050,19 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (reqWidth < 0) {
- interp->result = "baseWidth can't be < 0";
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (reqHeight < 0) {
- interp->result = "baseHeight can't be < 0";
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (widthInc < 0) {
- interp->result = "widthInc can't be < 0";
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (heightInc < 0) {
- interp->result = "heightInc can't be < 0";
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
@@ -1060,7 +1082,7 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->hints.flags & WindowGroupHint) {
- interp->result = wmPtr->leaderName;
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
}
return TCL_OK;
}
@@ -1093,8 +1115,9 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPixmapHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_pixmap);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1153,8 +1176,9 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_mask);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1179,7 +1203,9 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
return TCL_OK;
} else {
wmPtr->iconName = Tk_GetUid(argv[3]);
@@ -1199,8 +1225,11 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
+ 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;
}
@@ -1228,7 +1257,7 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->icon != NULL) {
- interp->result = Tk_PathName(wmPtr->icon);
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
}
return TCL_OK;
}
@@ -1282,8 +1311,10 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d", wmPtr->maxWidth,
- wmPtr->maxHeight);
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->maxWidth, wmPtr->maxHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1303,8 +1334,10 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d", wmPtr->minWidth,
- wmPtr->minHeight);
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1328,19 +1361,19 @@ Tk_WmCmd(
}
if (argc == 3) {
if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- interp->result = "1";
+ Tcl_SetResult(interp, "1", TCL_STATIC);
} else {
- interp->result = "0";
+ Tcl_SetResult(interp, "0", TCL_STATIC);
}
return TCL_OK;
}
if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
return TCL_ERROR;
}
- atts.override_redirect = (boolean) ? True : False;
- Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
- &atts);
- wmPtr->style = (boolean) ? plainDBox : documentProc;
+ atts.override_redirect = (boolean) ? True : False;
+ Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
+ &atts);
+ wmPtr->style = (boolean) ? plainDBox : documentProc;
} else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0)
&& (length >= 2)) {
if ((argc != 3) && (argc != 4)) {
@@ -1351,9 +1384,9 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USPosition) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PPosition) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1408,7 +1441,7 @@ Tk_WmCmd(
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- interp->result = protPtr->command;
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
return TCL_OK;
}
}
@@ -1452,9 +1485,12 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d",
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
@@ -1487,9 +1523,9 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USSize) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PSize) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1515,27 +1551,80 @@ Tk_WmCmd(
goto updateGeom;
} else if ((c == 's') && (strncmp(argv[1], "state", length) == 0)
&& (length >= 2)) {
- if (argc != 3) {
+ if ((argc < 3) || (argc > 4)) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
- argv[0], " state window\"", (char *) NULL);
+ argv[0], " state window ?state?\"", (char *) NULL);
return TCL_ERROR;
}
- if (wmPtr->iconFor != NULL) {
- interp->result = "icon";
+ if (argc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ winPtr->pathName, ": it is an embedded window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = argv[3][0];
+ length = strlen(argv[3]);
+
+ if ((c == 'n') && (strncmp(argv[3], "normal", length) == 0)) {
+ TkpWmSetState(winPtr, NormalState);
+ /*
+ * This varies from 'wm deiconify' because it does not
+ * force the window to be raised and receive focus
+ */
+ } else if ((c == 'i')
+ && (strncmp(argv[3], "iconic", length) == 0)) {
+ 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 ((c == 'w')
+ && (strncmp(argv[3], "withdrawn", length) == 0)) {
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else if ((c == 'z')
+ && (strncmp(argv[3], "zoomed", length) == 0)) {
+ TkpWmSetState(winPtr, ZoomState);
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be normal, iconic, withdrawn or zoomed",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
} else {
- switch (wmPtr->hints.initial_state) {
- case NormalState:
- interp->result = "normal";
- break;
- case IconicState:
- interp->result = "iconic";
- break;
- case WithdrawnState:
- interp->result = "withdrawn";
- break;
- case ZoomState:
- interp->result = "zoomed";
- break;
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else {
+ switch (wmPtr->hints.initial_state) {
+ case NormalState:
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ break;
+ case IconicState:
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ break;
+ case WithdrawnState:
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ break;
+ case ZoomState:
+ Tcl_SetResult(interp, "zoomed", TCL_STATIC);
+ break;
+ }
}
}
} else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
@@ -1546,8 +1635,9 @@ Tk_WmCmd(
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid
- : winPtr->nameUid;
+ Tcl_SetResult(interp,
+ ((wmPtr->titleUid != NULL) ? wmPtr->titleUid : winPtr->nameUid),
+ TCL_STATIC);
return TCL_OK;
} else {
wmPtr->titleUid = Tk_GetUid(argv[3]);
@@ -1566,7 +1656,7 @@ Tk_WmCmd(
}
if (argc == 3) {
if (wmPtr->master != None) {
- interp->result = wmPtr->masterWindowName;
+ Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
}
return TCL_OK;
}
@@ -2146,7 +2236,7 @@ UpdateSizeHints(
*
* Results:
* A standard Tcl return value, plus an error message in
- * interp->result if an error occurs.
+ * the interp's result if an error occurs.
*
* Side effects:
* The size and/or location of winPtr may change.
@@ -2399,6 +2489,7 @@ Tk_CoordsToWindow(
* 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.
@@ -2411,7 +2502,8 @@ Tk_CoordsToWindow(
return NULL;
}
rootChild = TkMacGetXWindow(whichWin);
- winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, rootChild);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, rootChild);
if (winPtr == NULL) {
return NULL;
}
@@ -2895,7 +2987,12 @@ TkWmRestackToplevel(
otherMacWindow = NULL;
}
+ if (TkMacHaveAppearance() >= 0x110) {
+ frontWindow = (WindowPeek) FrontNonFloatingWindow();
+ } else {
frontWindow = (WindowPeek) FrontWindow();
+ }
+
if (aboveBelow == Above) {
if (macWindow == frontWindow) {
/*
@@ -3255,6 +3352,7 @@ TkMacGrowToplevel(
Point start)
{
Point where = start;
+ TkDisplay *dispPtr;
GlobalToLocal(&where);
if (where.h > (whichWindow->portRect.right - 16) &&
@@ -3267,7 +3365,8 @@ TkMacGrowToplevel(
long growResult;
window = TkMacGetXWindow(whichWindow);
- winPtr = (TkWindow *) Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ winPtr = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
wmPtr = winPtr->wmInfoPtr;
/* TODO: handle grid size options. */
@@ -3330,15 +3429,19 @@ TkSetWMName(
{
Str255 pTitle;
GWorldPtr macWin;
+ int destWrote;
if (Tk_IsEmbedded(winPtr)) {
return;
}
+ Tcl_UtfToExternal(NULL, NULL, titleUid,
+ strlen(titleUid), 0, NULL,
+ (char *) &pTitle[1],
+ 255, NULL, &destWrote, NULL); /* Internalize native */
+ pTitle[0] = destWrote;
- macWin = TkMacGetDrawablePort(winPtr->window);
-
- strcpy((char *) pTitle + 1, titleUid);
- pTitle[0] = strlen(titleUid);
+ macWin = TkMacGetDrawablePort(winPtr->window);
+
SetWTitle((WindowPtr) macWin, pTitle);
}
@@ -3583,6 +3686,7 @@ TkMacZoomToplevel(
Point location = {0, 0};
int xOffset, yOffset;
WmInfo *wmPtr;
+ TkDisplay *dispPtr;
SetPort(whichWindow);
if (!TrackBox(whichWindow, where, zoomPart)) {
@@ -3595,7 +3699,8 @@ TkMacZoomToplevel(
* has changed.
*/
window = TkMacGetXWindow(whichWindow);
- tkwin = Tk_IdToWindow(tkDisplayList->display, window);
+ dispPtr = TkGetDisplayList();
+ tkwin = Tk_IdToWindow(dispPtr->display, window);
if (tkwin == NULL) {
return false;
}
@@ -3687,58 +3792,147 @@ TkUnsupported1Cmd(
c = argv[1][0];
length = strlen(argv[1]);
if ((c == 's') && (strncmp(argv[1], "style", length) == 0)) {
- if ((argc != 3) && (argc != 4)) {
- Tcl_AppendResult(interp, "wrong # arguments: must be \"",
- argv[0], " style window ?windowStyle?\"",
- (char *) NULL);
- return TCL_ERROR;
+ if (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:
- interp->result = "documentProc";
+ Tcl_SetResult(interp, "documentProc", TCL_STATIC);
break;
case dBoxProc:
- interp->result = "dBoxProc";
+ Tcl_SetResult(interp, "dBoxProc", TCL_STATIC);
break;
case plainDBox:
- interp->result = "plainDBox";
+ Tcl_SetResult(interp, "plainDBox", TCL_STATIC);
break;
case altDBoxProc:
- interp->result = "altDBoxProc";
+ Tcl_SetResult(interp, "altDBoxProc", TCL_STATIC);
break;
case movableDBoxProc:
- interp->result = "movableDBoxProc";
+ Tcl_SetResult(interp, "movableDBoxProc", TCL_STATIC);
break;
case zoomDocProc:
case zoomNoGrow:
- interp->result = "zoomDocProc";
+ Tcl_SetResult(interp, "zoomDocProc", TCL_STATIC);
break;
case rDocProc:
- interp->result = "rDocProc";
+ Tcl_SetResult(interp, "rDocProc", TCL_STATIC);
break;
case floatProc:
case floatGrowProc:
- interp->result = "floatProc";
+ Tcl_SetResult(interp, "floatProc", TCL_STATIC);
break;
case floatZoomProc:
case floatZoomGrowProc:
- interp->result = "floatZoomProc";
+ Tcl_SetResult(interp, "floatZoomProc", TCL_STATIC);
break;
case floatSideProc:
case floatSideGrowProc:
- interp->result = "floatSideProc";
+ Tcl_SetResult(interp, "floatSideProc", TCL_STATIC);
break;
case floatSideZoomProc:
case floatSideZoomGrowProc:
- interp->result = "floatSideZoomProc";
+ 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) {
@@ -3781,6 +3975,102 @@ TkUnsupported1Cmd(
(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;
+ 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",
@@ -3849,7 +4139,7 @@ TkMacMakeRealWindowExist(
WmInfo *wmPtr = winPtr->wmInfoPtr;
WindowRef newWindow = NULL;
MacDrawable *macWin;
- Rect geometry;
+ Rect geometry = {0,0,0,0};
Tcl_HashEntry *valueHashPtr;
int new;
TkMacWindowList *listPtr;
@@ -3892,8 +4182,29 @@ TkMacMakeRealWindowExist(
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");
}
@@ -4225,9 +4536,11 @@ TkMacHaveAppearance()
}
err = Gestalt(gestaltAppearanceVersion, &response);
if (err == noErr) {
- TkMacHaveAppearance = 2;
+ TkMacHaveAppearance = (int) response;
}
}
return TkMacHaveAppearance;
}
+
+
diff --git a/tk/mac/tkMacXCursors.r b/tk/mac/tkMacXCursors.r
index 18176d1ada3..1476be2cd3e 100644
--- a/tk/mac/tkMacXCursors.r
+++ b/tk/mac/tkMacXCursors.r
@@ -959,3 +959,4 @@ data 'crsr' (3075, "watch", purgeable) {
$"0000"
};
+
diff --git a/tk/mac/tkMacXStubs.c b/tk/mac/tkMacXStubs.c
index 96f53547658..25b7662c480 100644
--- a/tk/mac/tkMacXStubs.c
+++ b/tk/mac/tkMacXStubs.c
@@ -28,6 +28,7 @@
#include <ToolUtils.h>
#include <Sound.h>
#include "tkMacInt.h"
+#include "tkPort.h"
/*
* Because this file is still under major development Debugger statements are
@@ -462,6 +463,67 @@ XSendEvent(
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,
@@ -515,6 +577,14 @@ XForceScreenSaver(
*/
display->request++;
}
+
+void
+Tk_FreeXId (
+ Display *display,
+ XID xid)
+{
+ /* no-op function needed for stubs implementation. */
+}
/*
*----------------------------------------------------------------------
@@ -541,7 +611,8 @@ TkGetServerInfo(
Tk_Window tkwin) /* Token for window; this selects a
* particular display and server. */
{
- char buffer[50], buffer2[50];
+ 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)));
@@ -680,6 +751,31 @@ XSetWindowColormap(
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;
+}
+
/*
*----------------------------------------------------------------------
*
@@ -707,3 +803,4 @@ TkGetDefaultScreenName(
}
return screenName;
}
+
diff --git a/tk/tests/README b/tk/tests/README
index d1f4d1a46ac..ea935942dc4 100644
--- a/tk/tests/README
+++ b/tk/tests/README
@@ -1,30 +1,8 @@
-Tk Test Suite
---------------
+README -- Tk test suite design document.
RCS: @(#) $Id$
-This directory contains a set of validation tests for Tk.
-Each of the files whose name ends in ".test" is intended to
-fully exercise one or a few Tk features. The features
-tested by a given file are listed in the first line of the
-file. The test suite is nowhere near complete yet. Contributions
-of additional tests would be most welcome.
+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.
-You can run the tests in two ways:
- (a) type "make test" in the directory ../unix; this will run all of
- the tests.
- (b) start up tktest in this directory, then "source" the test
- file (for example, type "source pack.test"). To run all
- of the tests, type "source all".
-In either case no output will be generated if all goes well, except
-for a listing of the tests. If there are errors then additional
-messages will appear.
-
-For more details on the testing environment, see the README
-file in the Tcl test directory.
-
-You can also run a set of visual tests, which create various screens
-that you can verify visually for appropriate behavior. The visual
-tests are available through the "visual" script: if you invoke this
-script, it creates a main window with a bunch of menus. Each menu
-runs a particular test.
diff --git a/tk/tests/all.tcl b/tk/tests/all.tcl
new file mode 100644
index 00000000000..dea18b63876
--- /dev/null
+++ b/tk/tests/all.tcl
@@ -0,0 +1,78 @@
+# all.tcl --
+#
+# This file contains a top-level script to run all of the Tk
+# tests. Execute it by invoking "source all.tcl" when running tktest
+# in this directory.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+set ::tcltest::testSingleFile false
+
+puts stdout "Tk $tk_patchLevel tests running in interp: [info nameofexecutable]"
+puts stdout "Tests running in working dir: $::tcltest::workingDir"
+if {[llength $::tcltest::skip] > 0} {
+ puts stdout "Skipping tests that match: $::tcltest::skip"
+}
+if {[llength $::tcltest::match] > 0} {
+ puts stdout "Only running tests that match: $::tcltest::match"
+}
+
+# Use command line specified glob pattern (specified by -file or -f)
+# if one exists. Otherwise use *.test. If given, the file pattern
+# should be specified relative to the dir containing this file. If no
+# files are found to match the pattern, print an error message and exit.
+set fileIndex [expr {[lsearch $argv "-file"] + 1}]
+set fIndex [expr {[lsearch $argv "-f"] + 1}]
+if {($fileIndex < 1) || ($fIndex > $fileIndex)} {
+ set fileIndex $fIndex
+}
+if {$fileIndex > 0} {
+ set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]]
+ puts stdout "Sourcing files that match: $globPattern"
+} else {
+ set globPattern [file join $::tcltest::testsDir *.test]
+}
+set fileList [glob -nocomplain $globPattern]
+if {[llength $fileList] < 1} {
+ puts "Error: no files found matching $globPattern"
+ exit
+}
+set timeCmd {clock format [clock seconds]}
+puts stdout "Tests began at [eval $timeCmd]"
+
+# source each of the specified tests
+foreach file [lsort $fileList] {
+ set tail [file tail $file]
+ if {[string match l.*.test $tail]} {
+ # This is an SCCS lockfile; ignore it
+ continue
+ }
+ puts stdout $tail
+ if {[catch {source $file} msg]} {
+ puts stdout $msg
+ }
+}
+
+# cleanup
+puts stdout "\nTests ended at [eval $timeCmd]"
+::tcltest::cleanupTests 1
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/arc.tcl b/tk/tests/arc.tcl
index f164b4b9cb1..6f754639270 100644
--- a/tk/tests/arc.tcl
+++ b/tk/tests/arc.tcl
@@ -138,3 +138,16 @@ bind .t.c a {
bind .t.c b {set go 0}
bind .t.c <Control-x> {.t.c delete current}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/bell.test b/tk/tests/bell.test
index 4ea8983edfe..e2d66f62be1 100644
--- a/tk/tests/bell.test
+++ b/tk/tests/bell.test
@@ -2,16 +2,13 @@
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
test bell-1.1 {bell command} {
@@ -29,9 +26,24 @@ test bell-1.4 {bell command} {
after 500
bell -displayof .
after 200
- bell -dis .
- after 200
bell
after 200
bell
} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/bevel.tcl b/tk/tests/bevel.tcl
index ea89b092565..9a55f966cbc 100644
--- a/tk/tests/bevel.tcl
+++ b/tk/tests/bevel.tcl
@@ -126,3 +126,16 @@ foreach i {1 2 3} {
.t.t insert end rrr r1
.t.t insert end *****
.t.t insert end rrr r1
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/bgerror.test b/tk/tests/bgerror.test
index d98f2cac2a2..c821389b6dd 100644
--- a/tk/tests/bgerror.test
+++ b/tk/tests/bgerror.test
@@ -2,17 +2,15 @@
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info commands test] == ""} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-
test bgerror-1.1 {bgerror / tkerror compat} {
set errRes {}
proc tkerror {err} {
@@ -57,3 +55,19 @@ catch {rename tkerror {}}
# would be needed too, but that's not easy at all
# to emulate.
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/bind.test b/tk/tests/bind.test
index f03961e3506..1aa7d8202b9 100644
--- a/tk/tests/bind.test
+++ b/tk/tests/bind.test
@@ -4,15 +4,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] != 0} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
catch {destroy .b}
@@ -220,6 +218,7 @@ test bind-5.1 {Tk_CreateBindingTable procedure} {
if {[string compare testcbind [info commands testcbind]] != 0} {
puts "This application hasn't been compiled with the testcbind command,"
puts "therefore I am skipping all of these tests."
+ ::tcltest::cleanupTests
return
}
@@ -254,7 +253,7 @@ test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} {
set x
} {a1 bye.all2 bye.a1 b1 bye.c1}
-test bind-7.1 {Tk_CreateBinding procedure: error} {
+test bind-7.1 {Tk_CreateBinding procedure: bad binding} {
catch {destroy .b.c}
canvas .b.c
list [catch {.b.c bind foo <} msg] $msg
@@ -1039,8 +1038,10 @@ test bind-15.14 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1048,8 +1049,10 @@ test bind-15.15 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1057,8 +1060,10 @@ test bind-15.16 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1066,8 +1071,10 @@ test bind-15.17 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1075,8 +1082,10 @@ test bind-15.18 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1084,8 +1093,10 @@ test bind-15.19 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1093,8 +1104,10 @@ test bind-15.20 {MatchPatterns procedure, checking "nearby"} {
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"} {
@@ -1102,8 +1115,10 @@ test bind-15.21 {MatchPatterns procedure, checking "nearby"} {
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} {
@@ -1112,6 +1127,7 @@ test bind-15.22 {MatchPatterns procedure, time wrap-around} {
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} {
@@ -1120,6 +1136,7 @@ test bind-15.23 {MatchPatterns procedure, time wrap-around} {
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} {
@@ -1128,6 +1145,7 @@ test bind-15.24 {MatchPatterns procedure, virtual event} {
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} {
@@ -1136,6 +1154,7 @@ test bind-15.25 {MatchPatterns procedure, reject a virtual event} {
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} {
@@ -1148,10 +1167,12 @@ test bind-15.26 {MatchPatterns procedure, reject a virtual event} {
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} {
@@ -1187,6 +1208,7 @@ test bind-15.30 {MatchPatterns procedure, conflict resolution} {
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} {
@@ -1214,6 +1236,7 @@ test bind-15.33 {MatchPatterns procedure, conflict resolution} {
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] {
@@ -1245,6 +1268,7 @@ test bind-16.4 {ExpandPercents procedure} {
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} {
@@ -1398,9 +1422,10 @@ test bind-16.26 {ExpandPercents procedure} {
setup
bind .b.f <1> {set x "%s"}
set x none
- event gen .b.f <Button-1> -state 122
+ event gen .b.f <Button-1> -state 1402
+ event gen .b.f <ButtonRelease-1>
set x
-} 122
+} 1402
test bind-16.27 {ExpandPercents procedure} {
setup
bind .b.f <Enter> {set x "%s"}
@@ -1434,6 +1459,7 @@ test bind-16.31 {ExpandPercents procedure} {
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} {
@@ -1441,6 +1467,7 @@ test bind-16.32 {ExpandPercents procedure} {
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} {
@@ -1470,8 +1497,11 @@ test bind-16.35 {ExpandPercents procedure} {nonPortable} {
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} {{}} {{}} { } {\$} \\\{"
+} "a A { } {\r} {{}} {{}} { } {\$} \\\{ {{}} {{}} \u00e9"
test bind-16.36 {ExpandPercents procedure} {
setup
bind .b.f <Configure> {set x "%B"}
@@ -1533,16 +1563,17 @@ test bind-16.43 {ExpandPercents procedure} {
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 ?arg1?"}}
+} {1 {wrong # args: should be "event option ?arg?"}}
test bind-17.2 {event command} {
- list [catch {event {}} msg] $msg
-} {1 {bad option "": should be add, delete, generate, info}}
+ 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 ...?"}}
@@ -1611,8 +1642,7 @@ test bind-17.16 {event command: generate} {
} {1 {bad event type or keysym "xyz"}}
test bind-17.17 {event command} {
list [catch {event foo} msg] $msg
-} {1 {bad option "foo": should be add, delete, generate, info}}
-
+} {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
@@ -1710,8 +1740,10 @@ test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} {
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} {
@@ -1722,10 +1754,14 @@ test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} {
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} {
@@ -1738,12 +1774,18 @@ test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} {
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} {
@@ -1756,12 +1798,18 @@ test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} {
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} {
@@ -1777,12 +1825,18 @@ test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} {
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>>]
@@ -1800,12 +1854,18 @@ test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} {
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>>]
@@ -1823,12 +1883,18 @@ test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} {
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>>]
@@ -1884,9 +1950,9 @@ 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>
+ event gen [winfo id .b.f] <Control-Button-1> -state 260
set x
-} {4 1}
+} {260 1}
test bind-22.5 {HandleEventGenerate} {
list [catch {event gen . <xyz>} msg] $msg
} {1 {bad event type or keysym "xyz"}}
@@ -1903,7 +1969,11 @@ 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} {
@@ -1932,6 +2002,7 @@ test bind-22.13 {HandleEventGenerate} {
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} {
@@ -1941,6 +2012,7 @@ test bind-22.14 {HandleEventGenerate} {
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
@@ -1953,6 +2025,7 @@ test bind-22.15 {HandleEventGenerate} {
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
@@ -1965,95 +2038,100 @@ test bind-22.16 {HandleEventGenerate} {
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 position "xyz": should be now, head, mark, tail}}
-set i 14
+} {1 {bad -when value "xyz": must be now, head, mark, or tail}}
+set i 18
foreach check {
{<Configure> %a {-above .xyz} {{1 {bad window path name ".xyz"}}}}
{<Configure> %a {-above .b} {[winfo id .b]}}
- {<Configure> %a {-above xyz} {{1 {expected integer but got "xyz"}}}}
+ {<Configure> %a {-above xyz} {{1 {bad window name/identifier "xyz"}}}}
{<Configure> %a {-above [winfo id .b]} {[winfo id .b]}}
- {<Key> %b {-above .} {{1 {bad option to <Key> event: "-above"}}}}
+ {<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 {bad option to <Key> event: "-borderwidth"}}}}
+ {<Key> %k {-borderwidth 2i} {{1 {<Key> event doesn't accept "-borderwidth" option}}}}
{<Button> %b {-button xyz} {{1 {expected integer but got "xyz"}}}}
{<Button> %b {-button 1} 1}
- {<Key> %k {-button 1} {{1 {bad option to <Key> event: "-button"}}}}
+ {<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 {bad option to <Key> event: "-count"}}}}
+ {<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, NotifyDetailNone}}}}
+ {<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 {bad option to <Key> event: "-detail"}}}}
+ {<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 {bad option to <Key> event: "-focus"}}}}
+ {<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 {bad option to <Key> event: "-height"}}}}
+ {<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 {bad option to <Button> event: "-keycode"}}}}
+ {<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 {bad option to <Button> event: "-keysym"}}}}
+ {<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, NotifyWhileGrabbed}}}}
+ {<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 {bad option to <Key> event: "-mode"}}}}
+ {<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 {bad option to <Key> event: "-override"}}}}
+ {<Key> %k {-override 1} {{1 {<Key> event doesn't accept "-override" option}}}}
- {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, PlaceOnBottom}}}}
+ {<Circulate> %p {-place xyz} {{1 {bad -place value "xyz": must be PlaceOnTop, or PlaceOnBottom}}}}
{<Circulate> %p {-place PlaceOnTop} PlaceOnTop}
- {<Key> %k {-place PlaceOnTop} {{1 {bad option to <Key> event: "-place"}}}}
+ {<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 {expected integer but got "xyz"}}}}
+ {<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 {bad option to <Configure> event: "-root"}}}}
+ {<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 {bad option to <Configure> event: "-rootx"}}}}
+ {<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 {bad option to <Configure> event: "-rooty"}}}}
+ {<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}
@@ -2065,41 +2143,44 @@ foreach check {
{<Key> %s {-state xyz} {{1 {expected integer but got "xyz"}}}}
{<Key> %s {-state 1} 1}
- {<Button> %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, VisibilityFullyObscured}}}}
+ {<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 {bad option to <Configure> event: "-state"}}}}
+ {<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 {expected integer but got "xyz"}}}}
+ {<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 {bad option to <Configure> event: "-subwindow"}}}}
+ {<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 {bad option to <Configure> event: "-time"}}}}
+ {<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 {bad option to <Key> event: "-width"}}}}
+ {<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 {expected integer but got "xyz"}}}}
+ {<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}
@@ -2107,11 +2188,12 @@ foreach check {
{<Configure> %W {-window .b.f} .b.f}
{<Gravity> %W {-window .b.f} .b.f}
{<Circulate> %W {-window .b.f} .b.f}
- {<Key> %W {-window .b.f} {{1 {bad option to <Key> event: "-window"}}}}
+ {<Key> %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]}}
@@ -2119,11 +2201,12 @@ foreach check {
{<Configure> %x {-x 2i} {[winfo pixels .b.f 2i]}}
{<Gravity> %x {-x 2i} {[winfo pixels .b.f 2i]}}
{<Reparent> %x {-x 2i} {[winfo pixels .b.f 2i]}}
- {<Map> %x {-x 2i} {{1 {bad option to <Map> event: "-x"}}}}
+ {<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]}}
@@ -2131,9 +2214,9 @@ foreach check {
{<Configure> %y {-y 2i} {[winfo pixels .b.f 2i]}}
{<Gravity> %y {-y 2i} {[winfo pixels .b.f 2i]}}
{<Reparent> %y {-y 2i} {[winfo pixels .b.f 2i]}}
- {<Map> %y {-y 2i} {{1 {bad option to <Map> event: "-y"}}}}
+ {<Map> %y {-y 2i} {{1 {<Map> event doesn't accept "-y" option}}}}
- {<Key> %k {-xyz 1} {{1 {bad option to <Key> event: "-xyz"}}}}
+ {<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]" {
@@ -2178,16 +2261,24 @@ test bind-24.5 {FindSequence procedure, multiple bindings} {
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 triple}
+} {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}}
@@ -2196,7 +2287,9 @@ test bind-24.7 {FindSequence procedure: new pattern sequence} {
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} {
@@ -2206,8 +2299,11 @@ test bind-24.8 {FindSequence procedure: similar pattern sequence} {
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} {
@@ -2217,9 +2313,13 @@ test bind-24.9 {FindSequence procedure: similar pattern sequence} {
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} {
@@ -2229,10 +2329,15 @@ test bind-24.10 {FindSequence procedure: similar pattern sequence} {
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} {
@@ -2244,7 +2349,17 @@ test bind-24.12 {FindSequence procedure: not new sequence, don't create} {
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
@@ -2442,6 +2557,7 @@ foreach button {1 2 3 4 5} {
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
@@ -2511,6 +2627,7 @@ test bind-30.1 {Tk_BackgroundError procedure} {
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
@@ -2520,6 +2637,7 @@ test bind-30.1 {Tk_BackgroundError procedure} {
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}
@@ -2557,3 +2675,20 @@ test bind-31.2 {MouseWheel events} {
destroy .b
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/bitmap.test b/tk/tests/bitmap.test
new file mode 100644
index 00000000000..d91223938bf
--- /dev/null
+++ b/tk/tests/bitmap.test
@@ -0,0 +1,116 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkBitmap.c. It is organized in the standard white-box fashion for
+# Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testbitmap] != "testbitmap"} {
+ puts "testbitmap command not available; skipping tests"
+ ::tcltest::cleanupTests
+ return
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+test bitmap-1.1 {Tk_AllocBitmapFromObj - converting internal reps} {
+ set x gray25
+ lindex $x 0
+ destroy .b1
+ button .b1 -bitmap $x
+ lindex $x 0
+ testbitmap gray25
+} {{1 0}}
+test bitmap-1.2 {Tk_AllocBitmapFromObj - discard stale bitmap} {
+ set x gray25
+ destroy .b1 .b2
+ button .b1 -bitmap $x
+ destroy .b1
+ set result {}
+ lappend result [testbitmap gray25]
+ button .b2 -bitmap $x
+ lappend result [testbitmap gray25]
+} {{} {{1 1}}}
+test bitmap-1.3 {Tk_AllocBitmapFromObj - reuse existing bitmap} {
+ set x gray25
+ destroy .b1 .b2
+ button .b1 -bitmap $x
+ set result {}
+ lappend result [testbitmap gray25]
+ button .b2 -bitmap $x
+ pack .b1 .b2 -side top
+ lappend result [testbitmap gray25]
+} {{{1 1}} {{2 1}}}
+
+test bitmap-2.1 {Tk_GetBitmap procedure} {
+ destroy .b1
+ list [catch {button .b1 -bitmap bad_name} msg] $msg
+} {1 {bitmap "bad_name" not defined}}
+test bitmap-2.2 {Tk_GetBitmap procedure} {
+ destroy .b1
+ list [catch {button .b1 -bitmap @xyzzy} msg] $msg
+} {1 {error reading bitmap file "xyzzy"}}
+
+test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} {
+ set x questhead
+ destroy .b1 .b2 .b3
+ button .b1 -bitmap $x
+ button .b3 -bitmap $x
+ button .b2 -bitmap $x
+ set result {}
+ lappend result [testbitmap questhead]
+ destroy .b1
+ lappend result [testbitmap questhead]
+ destroy .b2
+ lappend result [testbitmap questhead]
+ destroy .b3
+ lappend result [testbitmap questhead]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+
+test bitmap-4.1 {FreeBitmapObjProc} {
+ destroy .b
+ set x [format questhead]
+ button .b -bitmap $x
+ set y [format questhead]
+ .b configure -bitmap $y
+ set z [format questhead]
+ .b configure -bitmap $z
+ set result {}
+ lappend result [testbitmap questhead]
+ set x red
+ lappend result [testbitmap questhead]
+ set z 32
+ lappend result [testbitmap questhead]
+ destroy .b
+ lappend result [testbitmap questhead]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/border.test b/tk/tests/border.test
new file mode 100644
index 00000000000..483e44d36ef
--- /dev/null
+++ b/tk/tests/border.test
@@ -0,0 +1,195 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkBorder.c. It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testborder] != "testborder"} {
+ puts "testborder command not available; skipping tests"
+ ::tcltest::cleanupTests
+ return
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+# Create a top-level with its own colormap (so we can test under
+# controlled conditions), then check to make sure that the visual
+# is color-mapped with 256 borders. If not, just skip this whole
+# test file.
+
+if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
+ ::tcltest::cleanupTests
+ return
+}
+wm geom .t +0+0
+if {[winfo depth .t] != 8} {
+ destroy .t
+ ::tcltest::cleanupTests
+ return
+}
+
+test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} {
+ set x orange
+ lindex $x 0
+ destroy .b1
+ button .b1 -bg $x -text .b1
+ lindex $x 0
+ testborder orange
+} {{1 0}}
+test border-1.3 {Tk_AllocBorderFromObj - discard stale border} {
+ set x orange
+ destroy .b1 .b2
+ button .b1 -bg $x -text First
+ destroy .b1
+ set result {}
+ lappend result [testborder orange]
+ button .b2 -bg $x -text Second
+ lappend result [testborder orange]
+} {{} {{1 1}}}
+test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} {
+ set x orange
+ destroy .b1 .b2
+ button .b1 -bg $x -text First
+ set result {}
+ lappend result [testborder orange]
+ button .b2 -bg $x -text Second
+ pack .b1 .b2 -side top
+ lappend result [testborder orange]
+} {{{1 1}} {{2 1}}}
+test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -bg $x -text First
+ pack .b1 -side top
+ set result {}
+ lappend result [testborder purple]
+ button .t.b -bg $x -text Second
+ pack .t.b -side top
+ lappend result [testborder purple]
+ button .b2 -bg $x -text Third
+ pack .b2 -side top
+ lappend result [testborder purple]
+} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+
+test border-3.1 {Tk_Free3DBorder - reference counts} {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -bg $x -text First
+ pack .b1 -side top
+ button .t.b -bg $x -text Second
+ pack .t.b -side top
+ button .b2 -bg $x -text Third
+ pack .b2 -side top
+ set result {}
+ lappend result [testborder purple]
+ destroy .b1
+ lappend result [testborder purple]
+ destroy .b2
+ lappend result [testborder purple]
+ destroy .t.b
+ lappend result [testborder purple]
+} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test border-3.4 {Tk_Free3DBorder - unlinking from list} {
+ destroy .b .t.b .t2 .t3
+ toplevel .t2 -visual {pseudocolor 8} -colormap new
+ toplevel .t3 -visual {pseudocolor 8} -colormap new
+ set x purple
+ button .b -bg $x -text .b1
+ button .t.b1 -bg $x -text .t.b1
+ button .t.b2 -bg $x -text .t.b2
+ button .t2.b1 -bg $x -text .t2.b1
+ button .t2.b2 -bg $x -text .t2.b2
+ button .t2.b3 -bg $x -text .t2.b3
+ button .t3.b1 -bg $x -text .t3.b1
+ button .t3.b2 -bg $x -text .t3.b2
+ button .t3.b3 -bg $x -text .t3.b3
+ button .t3.b4 -bg $x -text .t3.b4
+ set result {}
+ lappend result [testborder purple]
+ destroy .t2
+ lappend result [testborder purple]
+ destroy .b
+ lappend result [testborder purple]
+ destroy .t3
+ lappend result [testborder purple]
+ destroy .t
+ lappend result [testborder purple]
+} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
+test border-4.1 {FreeBorderObjProc} {
+ destroy .b
+ set x [format purple]
+ button .b -bg $x -text .b1
+ set y [format purple]
+ .b configure -bg $y
+ set z [format purple]
+ .b configure -bg $z
+ set result {}
+ lappend result [testborder purple]
+ set x red
+ lappend result [testborder purple]
+ set z 32
+ lappend result [testborder purple]
+ destroy .b
+ lappend result [testborder purple]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+catch {destroy .b}
+button .b
+test get-2.1 {Tk_GetReliefFromObj} {
+ .b configure -relief flat
+ .b cget -relief
+} {flat}
+test get-2.2 {Tk_GetReliefFromObj} {
+ .b configure -relief groove
+ .b cget -relief
+} {groove}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief raised
+ .b cget -relief
+} {raised}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief ridge
+ .b cget -relief
+} {ridge}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief solid
+ .b cget -relief
+} {solid}
+test get-2.3 {Tk_GetReliefFromObj} {
+ .b configure -relief sunken
+ .b cget -relief
+} {sunken}
+test get-2.4 {Tk_GetReliefFromObj - error} {
+ list [catch {.b configure -relief upanddown} msg] $msg
+} {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/bugs.tcl b/tk/tests/bugs.tcl
index b03dd02eff6..36f30ce701f 100644
--- a/tk/tests/bugs.tcl
+++ b/tk/tests/bugs.tcl
@@ -28,3 +28,16 @@ test crash-1.1 {color} {
. configure -bg rgb:345
set foo ""
} {}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/butGeom.tcl b/tk/tests/butGeom.tcl
index 9d82980764c..38991e30cdd 100644
--- a/tk/tests/butGeom.tcl
+++ b/tk/tests/butGeom.tcl
@@ -113,3 +113,16 @@ proc config {option value} {
$w configure $option $value
}
}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/butGeom2.tcl b/tk/tests/butGeom2.tcl
index f1a074a04f8..65e90fae734 100644
--- a/tk/tests/butGeom2.tcl
+++ b/tk/tests/butGeom2.tcl
@@ -111,3 +111,16 @@ proc config-but {option value} {
$w configure $option $value
}
}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/button.test b/tk/tests/button.test
index 2d44d5dc54d..df4d883971e 100644
--- a/tk/tests/button.test
+++ b/tk/tests/button.test
@@ -4,23 +4,23 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\""
puts "image, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -51,255 +51,216 @@ update
set i 1
foreach test {
{-activebackground #012345 #012345 non-existent
- {unknown color name "non-existent"}}
+ {unknown color name "non-existent"} {1 1 1 1}}
{-activeforeground #ff0000 #ff0000 non-existent
- {unknown color name "non-existent"}}
- {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+ {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"}}
- {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
- {-bd 4 4 badValue {bad screen distance "badValue"}}
- {-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
- {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
- {-command "set x" {set x} {} {}}
- {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
- {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
- {-fg #110022 #110022 bogus {unknown color name "bogus"}}
- {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}}
- {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
- {-height 18 18 20.0 {expected integer but got "20.0"}}
- {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
- {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
- {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
- {-image image1 image1 bogus {image "bogus" doesn't exist}}
- {-indicatoron yes 1 no_way {expected boolean value but got "no_way"}}
- {-justify right right bogus {bad justification "bogus": must be left, right, or center}}
- {-offvalue lousy lousy {} {}}
- {-offvalue fantastic fantastic {} {}}
- {-padx 12 12 420x {bad screen distance "420x"}}
- {-pady 12 12 420x {bad screen distance "420x"}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
- {-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
- {-selectimage image1 image1 bogus {image "bogus" doesn't exist}}
- {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
- {-takefocus "any string" "any string" {} {}}
- {-text "Sample text" {Sample text} {} {}}
- {-textvariable i i {} {}}
- {-underline 5 5 3p {expected integer but got "3p"}}
- {-width 402 402 3p {expected integer but got "3p"}}
- {-wraplength 100 100 6x {bad screen distance "6x"}}
+ {unknown color name "non-existent"} {1 1 1 1}}
+ {-bd 4 4 badValue {bad screen distance "badValue"} {1 1 1 1}}
+ {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}
+ {1 1 1 1}}
+ {-bitmap questhead questhead badValue {bitmap "badValue" not defined}
+ {1 1 1 1}}
+ {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"} {1 1 1 1}}
+ {-command "set x" {set x} {} {} {0 1 1 1}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"} {1 1 1 1}}
+ {-default active active huh?
+ {bad default "huh?": must be active, disabled, or normal}
+ {0 1 0 0}}
+ {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}
+ {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}}
+ {-offvalue lousy lousy {} {} {0 0 1 0}}
+ {-offvalue fantastic fantastic {} {} {0 0 1 0}}
+ {-padx 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+ {-pady 12m 12m 420x {bad screen distance "420x"} {1 1 1 1}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} {1 1 1 1}}
+ {-selectcolor #110022 #110022 bogus {unknown color name "bogus"} {0 0 1 1}}
+ {-selectimage image1 image1 bogus {image "bogus" doesn't exist} {0 0 1 1}}
+ {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal} {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]
- test button-1.$i {configuration options} {
- .c configure $name [lindex $test 1]
- lindex [.c configure $name] 4
- } [lindex $test 2]
- incr i
- if {[lindex $test 3] != ""} {
- test button-1.$i {configuration options} {
- list [catch {.c configure $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ set classes [lindex $test 5]
+ foreach w {.l .b .c .r} hasOption [lindex $test 5] {
+ if $hasOption {
+ test button-1.$i {configuration options} {
+ $w configure $name [lindex $test 1]
+ lindex [$w configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test button-1.$i {configuration options} {
+ list [catch {$w configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ $w configure $name [lindex [$w configure $name] 3]
+ } else {
+ test button-1.$i {configuration options} {
+ list [catch {$w configure $name [lindex $test 1]} msg] $msg
+ } "1 {unknown option \"$name\"}"
+ }
}
- .c configure $name [lindex [.c configure $name] 3]
incr i
}
test button-1.$i {configuration options} {
.c configure -selectcolor {}
} {}
-incr i
-# the following tests only work on buttons, not checkbuttons
-test button-1.$i {configuration options} {
- .b configure -default active
- lindex [.b configure -default] 4
-} active
-incr i
-test button-1.$i {configuration options} {
- .b configure -default normal
- lindex [.b configure -default] 4
-} normal
-incr i
-test button-1.$i {configuration options} {
- .b configure -default disabled
- lindex [.b configure -default] 4
-} disabled
-incr i
-test button-1.$i {configuration options} {
- .b configure -default active
- lindex [.b configure -default] 3
-} disabled
-incr i
-test button-1.$i {configuration options} {
- list [catch {.b configure -default no_way} msg] $msg
-} {1 {bad -default value "no_way": must be normal, active, or disabled}}
-set i 1
-foreach check {
- {-activebackground 1 0 0 0}
- {-activeforeground 1 0 0 0}
- {-anchor 0 0 0 0}
- {-background 0 0 0 0}
- {-bd 0 0 0 0}
- {-bg 0 0 0 0}
- {-bitmap 0 0 0 0}
- {-borderwidth 0 0 0 0}
- {-command 1 0 0 0}
- {-cursor 0 0 0 0}
- {-default 1 0 1 1}
- {-disabledforeground 1 0 0 0}
- {-fg 0 0 0 0}
- {-font 0 0 0 0}
- {-foreground 0 0 0 0}
- {-height 0 0 0 0}
- {-image 0 0 0 0}
- {-indicatoron 1 1 0 0}
- {-offvalue 1 1 0 1}
- {-onvalue 1 1 0 1}
- {-padx 0 0 0 0}
- {-pady 0 0 0 0}
- {-relief 0 0 0 0}
- {-selectcolor 1 1 0 0}
- {-selectimage 1 1 0 0}
- {-state 1 0 0 0}
- {-text 0 0 0 0}
- {-textvariable 0 0 0 0}
- {-value 1 1 1 0}
- {-variable 1 1 0 0}
- {-width 0 0 0 0}
+test button-3.1 {ButtonCreate - not enough cd ../unix
} {
- test button-2.$i {label-specific options} "
- catch {.l configure [lindex $check 0]}
- " [lindex $check 1]
- incr i
- test button-2.$i {button-specific options} "
- catch {.b configure [lindex $check 0]}
- " [lindex $check 2]
- incr i
- test button-2.$i {checkbutton-specific options} "
- catch {.c configure [lindex $check 0]}
- " [lindex $check 3]
- incr i
- test button-2.$i {radiobutton-specific options} "
- catch {.r configure [lindex $check 0]}
- " [lindex $check 4]
- incr i
-}
-
-test button-3.1 {ButtonCreate procedure} {
list [catch {button} msg] $msg
} {1 {wrong # args: should be "button pathName ?options?"}}
-test button-3.2 {ButtonCreate procedure} {
+test button-3.2 {ButtonCreate procedure - setting label class} {
catch {destroy .x}
label .x
winfo class .x
} {Label}
-test button-3.3 {ButtonCreate procedure} {
+test button-3.3 {ButtonCreate - setting button class} {
catch {destroy .x}
button .x
winfo class .x
} {Button}
-test button-3.4 {ButtonCreate procedure} {
+test button-3.4 {ButtonCreate - setting checkbutton class} {
catch {destroy .x}
checkbutton .x
winfo class .x
} {Checkbutton}
-test button-3.5 {ButtonCreate procedure} {
+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 procedure} {
+test button-3.6 {ButtonCreate - setting class} {
catch {destroy .x}
gorp .x
winfo class .x
} {Button}
rename gorp button
-test button-3.7 {ButtonCreate procedure} {
+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} {
+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 procedure} {
+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 procedure, "cget" option} {
+test button-4.2 {ButtonWidgetCmd - bad option name} {
list [catch {.b c} msg] $msg
-} {1 {bad option "c": must be cget, configure, flash, or invoke}}
-test button-4.3 {ButtonWidgetCmd procedure, "cget" option} {
+} {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.4 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
list [catch {.b cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
-test button-4.5 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
.b configure -highlightthickness 3
.b cget -highlightthickness
} {3}
-test button-4.6 {ButtonWidgetCmd procedure, "cget" option} {
- list [catch {.l cget -disabledforeground} msg] $msg
-} {1 {unknown option "-disabledforeground"}}
test button-4.7 {ButtonWidgetCmd procedure, "cget" option} {
- catch {.b cget -disabledforeground}
+ 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.9 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
catch {.c cget -variable}
} {0}
-test button-4.10 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
list [catch {.c cget -value} msg] $msg
} {1 {unknown option "-value"}}
-test button-4.11 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
catch {.r cget -value}
} {0}
-test button-4.12 {ButtonWidgetCmd procedure, "cget" option} {
+test button-4.13 {ButtonWidgetCmd procedure, "cget" option} {
list [catch {.r cget -onvalue} msg] $msg
} {1 {unknown option "-onvalue"}}
-test button-4.13 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
llength [.c configure]
} {36}
-test button-4.14 {ButtonWidgetCmd procedure, "configure" option} {
+test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
list [catch {.b configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
-test button-4.15 {ButtonWidgetCmd procedure, "configure" option} {
+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.16 {ButtonWidgetCmd procedure, "configure" option} {
+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.17 {ButtonWidgetCmd procedure, "deselect" option} {
+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.18 {ButtonWidgetCmd procedure, "deselect" option} {
+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.19 {ButtonWidgetCmd procedure, "deselect" option} {
+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.20 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
set value 1
.c d
set value
} {0}
-test button-4.21 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
set value2 green
.r deselect
set value2
} {green}
-test button-4.22 {ButtonWidgetCmd procedure, "deselect" option} {
+test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
set value2 red
.r deselect
set value2
} {}
-test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
+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]
@@ -308,7 +269,7 @@ test button-4.23 {ButtonWidgetCmd procedure, "deselect" option} {
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
while executing
".c deselect"} 0}
-test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
+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]
@@ -317,40 +278,40 @@ test button-4.24 {ButtonWidgetCmd procedure, "deselect" option} {
} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
while executing
".r deselect"} {}}
-test button-4.25 {ButtonWidgetCmd procedure, "flash" option} {
+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.26 {ButtonWidgetCmd procedure, "flash" option} {
+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.27 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
list [catch {.b flash} msg] $msg
} {0 {}}
-test button-4.28 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
list [catch {.c flash} msg] $msg
} {0 {}}
-test button-4.29 {ButtonWidgetCmd procedure, "flash" option} {
+test button-4.30 {ButtonWidgetCmd procedure, "flash" option} {
list [catch {.r f} msg] $msg
} {0 {}}
-test button-4.30 {ButtonWidgetCmd procedure, "invoke" option} {
+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.31 {ButtonWidgetCmd procedure, "invoke" option} {
+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.32 {ButtonWidgetCmd procedure, "invoke" option} {
+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.33 {ButtonWidgetCmd procedure, "invoke" option} {
+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.34 {ButtonWidgetCmd procedure, "invoke" option} {
+test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
set value bogus
.c configure -command {set x invoked} -variable value -onvalue 1 \
-offvalue 0
@@ -358,35 +319,35 @@ test button-4.34 {ButtonWidgetCmd procedure, "invoke" option} {
.c invoke
list $x $value
} {invoked 1}
-test button-4.35 {ButtonWidgetCmd procedure, "invoke" option} {
+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.36 {ButtonWidgetCmd procedure, "select" option} {
+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.37 {ButtonWidgetCmd procedure, "select" option} {
+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.38 {ButtonWidgetCmd procedure, "select" option} {
+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.39 {ButtonWidgetCmd procedure, "select" option} {
+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.40 {ButtonWidgetCmd procedure, "select" option} {
+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.41 {ButtonWidgetCmd procedure, "select" option} {
+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]
@@ -395,19 +356,19 @@ test button-4.41 {ButtonWidgetCmd procedure, "select" option} {
} {1 {can't set "value2": trace aborted} {can't set "value2": trace aborted
while executing
".r select"} red}
-test button-4.42 {ButtonWidgetCmd procedure, "toggle" option} {
+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.43 {ButtonWidgetCmd procedure, "toggle" option} {
+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.44 {ButtonWidgetCmd procedure, "toggle" option} {
+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.45 {ButtonWidgetCmd procedure, "toggle" option} {
+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.46 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
set value bogus
.c configure -command {} -variable value -onvalue sunshine -offvalue rain
.c toggle
@@ -417,7 +378,7 @@ test button-4.46 {ButtonWidgetCmd procedure, "toggle" option} {
.c toggle
lappend result $value
} {sunshine rain sunshine}
-test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
.c configure -onvalue xyz -offvalue abc
set value xyz
trace variable value w bogusTrace
@@ -427,7 +388,7 @@ test button-4.47 {ButtonWidgetCmd procedure, "toggle" option} {
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
while executing
".c toggle"} abc}
-test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
+test button-4.49 {ButtonWidgetCmd procedure, "toggle" option} {
.c configure -onvalue xyz -offvalue abc
set value abc
trace variable value w bogusTrace
@@ -437,9 +398,6 @@ test button-4.48 {ButtonWidgetCmd procedure, "toggle" option} {
} {1 {can't set "value": trace aborted} {can't set "value": trace aborted
while executing
".c toggle"} xyz}
-test button-4.49 {ButtonWidgetCmd procedure} {
- list [catch {.c bad_option} msg] $msg
-} {1 {bad option "bad_option": must be cget, configure, deselect, flash, invoke, select, or toggle}}
test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
catch {unset value}; set value(1) 1;
set result [list [catch {.c toggle} msg] $msg $errorInfo]
@@ -462,7 +420,14 @@ test button-5.1 {DestroyButton procedure} {
eval destroy [winfo children .]
} {}
-test button-6.1 {ConfigureButton procedure} {
+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
@@ -471,7 +436,7 @@ test button-6.1 {ConfigureButton procedure} {
set x New
lindex [.b1 configure -text] 4
} {From-y}
-test button-6.2 {ConfigureButton procedure} {
+test button-6.2 {ConfigureButton - variable traces} {
catch {destroy .b1}
catch {unset x}
checkbutton .b1 -variable x
@@ -482,7 +447,7 @@ test button-6.2 {ConfigureButton procedure} {
.b1 toggle
set y
} {1}
-test button-6.3 {ConfigureButton procedure} {
+test button-6.3 {ConfigureButton - image handling} {
catch {destroy .b1}
eval image delete [image names]
image create test image1
@@ -492,18 +457,12 @@ test button-6.3 {ConfigureButton procedure} {
.b1 configure -image image2
image names
} {image2}
-test button-6.4 {ConfigureButton procedure} {
- catch {destroy .b1}
- button .b1 -text "Test" -state disabled
- list [catch {.b1 configure -state bogus} msg] $msg \
- [lindex [.b1 configure -state] 4]
-} {1 {bad state value "bogus": must be normal, active, or disabled} normal}
-test button-6.5 {ConfigureButton procedure} {
+test button-6.5 {ConfigureButton - default value for variable} {
catch {destroy .b1}
checkbutton .b1
.b1 cget -variable
} {b1}
-test button-6.6 {ConfigureButton procedure} {
+test button-6.6 {ConfigureButton - setting selected state from variable} {
catch {destroy .b1}
set x 0
set y Shiny
@@ -512,19 +471,19 @@ test button-6.6 {ConfigureButton procedure} {
.b1 toggle
set y
} 0
-test button-6.7 {ConfigureButton procedure} {
+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 procedure} {
+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 procedure} {
+test button-6.9 {ConfigureButton - error in setting variable} {
catch {destroy .b1}
catch {unset x}
trace variable x w bogusTrace
@@ -532,23 +491,23 @@ test button-6.9 {ConfigureButton procedure} {
trace vdelete x w bogusTrace
set result
} {1 {can't set "x": trace aborted}}
-test button-6.10 {ConfigureButton procedure} {
+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 procedure} {
+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 procedure} {
+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 procedure} {
+test button-6.13 {ConfigureButton - variable handling} {
catch {destroy .b1}
catch {unset x}
trace variable x w bogusTrace
@@ -557,7 +516,7 @@ test button-6.13 {ConfigureButton procedure} {
trace vdelete x w bogusTrace
set result
} {1 {can't set "x": trace aborted} foo}
-test button-6.14 {ConfigureButton procedure} {
+test button-6.14 {ConfigureButton - -width option} {
catch {destroy .b1}
button .b1 -text "Button 1"
list [catch {.b1 configure -width 1i} msg] $msg $errorInfo
@@ -565,7 +524,7 @@ test button-6.14 {ConfigureButton procedure} {
(processing -width option)
invoked from within
".b1 configure -width 1i"}}
-test button-6.15 {ConfigureButton procedure} {
+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
@@ -573,7 +532,7 @@ test button-6.15 {ConfigureButton procedure} {
(processing -height option)
invoked from within
".b1 configure -height 0.5c"}}
-test button-6.16 {ConfigureButton procedure} {
+test button-6.16 {ConfigureButton - -width option} {
catch {destroy .b1}
button .b1 -bitmap questhead
list [catch {.b1 configure -width abc} msg] $msg $errorInfo
@@ -581,7 +540,7 @@ test button-6.16 {ConfigureButton procedure} {
(processing -width option)
invoked from within
".b1 configure -width abc"}}
-test button-6.17 {ConfigureButton procedure} {
+test button-6.17 {ConfigureButton - -height option} {
catch {destroy .b1}
eval image delete [image names]
image create test image1
@@ -591,7 +550,7 @@ test button-6.17 {ConfigureButton procedure} {
(processing -height option)
invoked from within
".b1 configure -height 0.5x"}}
-test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
+test button-6.18 {ConfigureButton - computing geometry} {nonPortable fonts} {
catch {destroy .b1}
button .b1 -text "Sample text" -width 10 -height 2
pack .b1
@@ -599,7 +558,7 @@ test button-6.18 {ConfigureButton procedure} {nonPortable fonts} {
.b1 configure -bitmap questhead
lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
} {102 46 20 12}
-test button-6.19 {ConfigureButton procedure} {
+test button-6.19 {ConfigureButton - computing geometry} {
catch {destroy .b1}
button .b1 -text "Button 1"
set old [winfo reqwidth .b1]
@@ -820,3 +779,7 @@ eval destroy [winfo children .]
option clear
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/canvImg.test b/tk/tests/canvImg.test
index f10115e9333..0424d8a3348 100644
--- a/tk/tests/canvImg.test
+++ b/tk/tests/canvImg.test
@@ -4,23 +4,23 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -60,7 +60,7 @@ test canvImg-1.5 {options for image items} {
test canvImg-2.1 {CreateImage procedure} {
list [catch {.c create image 40} msg] $msg
-} {1 {wrong # args: should be ".c create image x y ?options?"}}
+} {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"}}
@@ -100,7 +100,7 @@ test canvImg-3.4 {ImageCoords procedure} {
.c delete all
.c create image 50 100 -image foo -tags i1
list [catch {.c coords i1 250} msg] $msg
-} {1 {wrong # coordinates: expected 0 or 2, got 1}}
+} {1 {wrong # coordinates: expected 2, got 1}}
test canvImg-3.5 {ImageCoords procedure} {
.c delete all
.c create image 50 100 -image foo -tags i1
@@ -395,3 +395,20 @@ test canvImg-11.3 {ImageChangedProc procedure} {
update
set y
} {{foo2 display 0 0 20 40 50 40}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/canvPs.test b/tk/tests/canvPs.test
index 98f3c950d1a..3c7cfe83f02 100644
--- a/tk/tests/canvPs.test
+++ b/tk/tests/canvPs.test
@@ -3,14 +3,13 @@
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -95,11 +94,24 @@ test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} {
set status
} ok
-# Clean-up
-
+# cleanup
removeFile foo.ps
removeFile bar.ps
-
foreach i [winfo children .] {
destroy $i
}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/canvPsBmap.tcl b/tk/tests/canvPsBmap.tcl
index 241b7bc9ef1..86aa55a211c 100644
--- a/tk/tests/canvPsBmap.tcl
+++ b/tk/tests/canvPsBmap.tcl
@@ -69,3 +69,16 @@ $c create bitmap 5.5i 5.5i \
-bitmap @[file join $tk_library demos/images/flagup.bmp] \
-background {} -foreground black -anchor se
$c create rect 5.47i 5.47i 5.53i 5.53i -fill {} -outline black
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/canvPsGrph.tcl b/tk/tests/canvPsGrph.tcl
index 8a2ddb7e875..4c02e475d0f 100644
--- a/tk/tests/canvPsGrph.tcl
+++ b/tk/tests/canvPsGrph.tcl
@@ -85,3 +85,16 @@ proc mkObjs c {
}
mkObjs $c
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/canvPsImg.tcl b/tk/tests/canvPsImg.tcl
new file mode 100644
index 00000000000..88a0648605b
--- /dev/null
+++ b/tk/tests/canvPsImg.tcl
@@ -0,0 +1,85 @@
+# 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 \
+ -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/tk/tests/canvPsText.tcl b/tk/tests/canvPsText.tcl
index 2274f36b9e3..02ec274e787 100644
--- a/tk/tests/canvPsText.tcl
+++ b/tk/tests/canvPsText.tcl
@@ -81,3 +81,16 @@ proc setStipple c {
global stipple
$c itemconfigure text -stipple $stipple
}
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/canvRect.test b/tk/tests/canvRect.test
index 28018935549..c83f5fc52d1 100644
--- a/tk/tests/canvRect.test
+++ b/tk/tests/canvRect.test
@@ -3,14 +3,13 @@
# in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -33,7 +32,7 @@ foreach test {
{-outline #123456 #123456 bad_color {unknown color name "bad_color"}}
{-stipple gray50 gray50 bogus {bitmap "bogus" not defined}}
{-tags {test a b c} {test a b c} {} {}}
- {-width 6 6 abc {bad screen distance "abc"}}
+ {-width 6.0 6.0 abc {bad screen distance "abc"}}
} {
set name [lindex $test 0]
test canvRect-1.$i {configuration options} {
@@ -118,11 +117,10 @@ test canvRect-3.7 {RectOvalCoords procedure} {
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}
+} {1 {bad screen distance "abc"} 1.0}
test canvRect-4.2 {ConfigureRectOval procedure} {
- .c itemconfigure x -width -5
- .c itemcget x -width
-} {1}
+ 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
@@ -294,7 +292,7 @@ test canvRect-10.1 {TranslateRectOval procedure} {
# This test is non-portable because different color information
# will get generated on different displays (e.g. mono displays
# vs. color).
-test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable win32sCrash macCrash} {
+test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable macCrash} {
# Crashes on Mac because the XGetImage() call isn't implemented, causing a
# dereference of NULL.
@@ -327,3 +325,20 @@ restore showpage
end
%%EOF
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/canvText.test b/tk/tests/canvText.test
index b9d2afec87d..884a84223fc 100644
--- a/tk/tests/canvText.test
+++ b/tk/tests/canvText.test
@@ -3,14 +3,13 @@
# fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {"[info procs test]" != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -106,7 +105,7 @@ test canvText-3.4 {TextCoords procedure} {
} {10.0 10.0}
test canvText-3.5 {TextCoords procedure} {
list [catch {.c coords test 10} msg] $msg
-} {1 {wrong # coordinates: expected 0 or 2, got 1}}
+} {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}}
@@ -174,7 +173,7 @@ test canvText-5.1 {ConfigureText procedure: adjust cursor} {
.c delete x
} {}
-test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
+test canvText-6.1 {ComputeTextBbox procedure} {fonts nonPortable} {
.c itemconfig test -font $font -text 0
.c coords test 0 0
set x {}
@@ -200,7 +199,7 @@ test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
focus .c
.c focus test
.c itemconfig test -text "abcd\nefghi\njklmnopq"
-test canvText-7.1 {DisplayText procedure: stippling} {
+test canvText-7.0 {DisplayText procedure: stippling} {
.c itemconfig test -stipple gray50
update
.c itemconfig test -stipple {}
@@ -241,6 +240,20 @@ 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 {}
@@ -491,3 +504,34 @@ restore showpage
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/tk/tests/canvWind.test b/tk/tests/canvWind.test
index 7e9d7da7ab7..b408b0d9477 100644
--- a/tk/tests/canvWind.test
+++ b/tk/tests/canvWind.test
@@ -3,14 +3,13 @@
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {"[info procs test]" != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -131,3 +130,21 @@ test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} {
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/tk/tests/canvas.test b/tk/tests/canvas.test
index 9bf32d9447c..c4b76906ac3 100644
--- a/tk/tests/canvas.test
+++ b/tk/tests/canvas.test
@@ -3,15 +3,13 @@
# standard fashion for Tcl tests.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-2000 Ajuba Solutions.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -69,13 +67,29 @@ foreach test {
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, xview option} {
+
+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
@@ -84,7 +98,7 @@ test canvas-2.1 {CanvasWidgetCmd, xview option} {
update
lappend x [.c xview]
} {{0 0.3} {0.4 0.7}}
-test canvas-2.2 {CanvasWidgetCmd, xview option} {nonPortable} {
+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
@@ -236,3 +250,124 @@ test canvas-9.1 {canvas id creation and deletion} {
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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/choosedir.test b/tk/tests/choosedir.test
new file mode 100644
index 00000000000..1b1d20ebd4d
--- /dev/null
+++ b/tk/tests/choosedir.test
@@ -0,0 +1,150 @@
+# 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$
+#
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+#----------------------------------------------------------------------
+#
+# 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/tk/tests/clipboard.test b/tk/tests/clipboard.test
index b730b09a852..240ae7e044f 100644
--- a/tk/tests/clipboard.test
+++ b/tk/tests/clipboard.test
@@ -3,9 +3,8 @@
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
@@ -14,8 +13,8 @@
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
eval destroy [winfo child .]
@@ -232,3 +231,20 @@ test clipboard-7.13 {Tk_ClipboardCmd procedure} {
test clipboard-7.14 {Tk_ClipboardCmd procedure} {
list [catch {clipboard error} msg] $msg
} {1 {bad option "error": must be clear or append}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/clrpick.test b/tk/tests/clrpick.test
index 69b621dc999..8bb7039c23c 100644
--- a/tk/tests/clrpick.test
+++ b/tk/tests/clrpick.test
@@ -2,22 +2,27 @@
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
#
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
+# Some tests require user interaction on non-unix platform
+
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+ [expr {$::tcltest::testConfig(userInteraction) || \
+ $::tcltest::testConfig(unixOnly)}]
+
test clrpick-1.1 {tk_chooseColor command} {
list [catch {tk_chooseColor -foo} msg] $msg
-} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}
+} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
-catch {tk_chooseColor -foo} msg
+catch {tk_chooseColor -foo 1} msg
regsub -all , $msg "" options
regsub \"-foo\" $options "" options
@@ -31,7 +36,7 @@ foreach option $options {
test clrpick-1.3 {tk_chooseColor command} {
list [catch {tk_chooseColor -foo bar} msg] $msg
-} {1 {unknown option "-foo", must be -initialcolor, -parent or -title}}
+} {1 {bad option "-foo": must be -initialcolor, -parent, or -title}}
test clrpick-1.4 {tk_chooseColor command} {
list [catch {tk_chooseColor -initialcolor} msg] $msg
@@ -55,14 +60,6 @@ if {[info commands tkColorDialog] == ""} {
set isNative 0
}
-if {$isNative && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
- return
-}
-
proc ToPressButton {parent btn} {
global isNative
if {!$isNative} {
@@ -141,8 +138,9 @@ set verylongstring $verylongstring$verylongstring
# let's soak up a bunch of colors...so that
# machines with small color palettes still fail.
+# some tests will be skipped if there are no more colors
set numcolors 32
-set nomorecolors 0
+set ::tcltest::testConfig(colorsLeftover) 1
set i 0
canvas .c
pack .c -expand 1 -fill both
@@ -160,7 +158,7 @@ while {$i<$numcolors} {
set g [expr $g/256]
set b [expr $b/256]
if {"$color" != "#[format %02x%02x%02x $r $g $b]"} {
- set nomorecolors 1
+ set ::tcltest::testConfig(colorsLeftover) 0
}
}
.c delete $i
@@ -169,47 +167,57 @@ while {$i<$numcolors} {
destroy .c
-if {!$nomorecolors} {
- set color #404040
- test clrpick-2.1 {tk_chooseColor command} {
- ToPressButton $parent ok
- tk_chooseColor -title "Press Ok $verylongstring" -initialcolor $color -parent $parent
- } "$color"
-
- set color #808040
- test clrpick-2.2 {tk_chooseColor command} {
- if {$tcl_platform(platform) == "macintosh"} {
- set colors "32768 32768 16384"
- } else {
- set colors "128 128 64"
- }
- ToChooseColorByKey $parent 128 128 64
- tk_chooseColor -parent $parent -title "choose $colors"
- } "$color"
-
- test clrpick-2.3 {tk_chooseColor command} {
- ToPressButton $parent ok
- tk_chooseColor -parent $parent -title "Press OK"
- } "$color"
-} else {
- puts "Skipped tests clrpick2.1, clrpick2.2 and clrpick2.3 because"
- puts "you ran out of colors in your color palette, and this would"
- puts "have caused the tests to generate errors."
-}
-
-test clrpick-2.4 {tk_chooseColor command} {
+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} {
+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} {
+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/tk/tests/cmap.tcl b/tk/tests/cmap.tcl
index 8fe0207ce15..f39d1786c60 100644
--- a/tk/tests/cmap.tcl
+++ b/tk/tests/cmap.tcl
@@ -59,3 +59,16 @@ pack .t2.quit -side bottom -pady 3 -ipadx 4 -ipady 2
frame .t2.f -height 320 -width 320
pack .t2.f -side bottom
colors .t2.f 0 0 4
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/cmds.test b/tk/tests/cmds.test
index 23a46700b88..cc86061ecab 100644
--- a/tk/tests/cmds.test
+++ b/tk/tests/cmds.test
@@ -2,14 +2,13 @@
# tkCmds.c. It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
eval destroy [winfo child .]
@@ -41,3 +40,20 @@ test cmds-1.5 {tkwait visibility, window gets deleted} {
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/tk/tests/color.test b/tk/tests/color.test
index 37867f6100f..a12b941127a 100644
--- a/tk/tests/color.test
+++ b/tk/tests/color.test
@@ -1,15 +1,20 @@
# This file is a Tcl script to test out the procedures in the file
# tkColor.c. It is organized in the standard fashion for Tcl tests.
#
-# Copyright (c) 1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1995-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testcolor] != "testcolor"} {
+ puts "testcolor command not available; skipping tests"
+ ::tcltest::cleanupTests
+ return
}
eval destroy [winfo children .]
@@ -103,11 +108,13 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} {
# test file.
if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
+ ::tcltest::cleanupTests
return
}
wm geom .t +0+0
if {[winfo depth .t] != 8} {
destroy .t
+ ::tcltest::cleanupTests
return
}
mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
@@ -115,31 +122,81 @@ pack .t.c
update
if ![colorsFree .t.c 101 233 17] {
destroy .t
+ ::tcltest::cleanupTests
return
}
mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
pack .t.c2
if [colorsFree .t.c] {
destroy .t
+ ::tcltest::cleanupTests
return
}
destroy .t.c .t.c2
-test color-1.1 {Tk_GetColor procedure} {
- c255 [winfo rgb .t red]
+test color-1.1 {Tk_AllocColorFromObj - converting internal reps} {
+ set x green
+ lindex $x 0
+ destroy .b1
+ button .b1 -foreground $x -text .b1
+ lindex $x 0
+ testcolor green
+} {{1 0}}
+test color-1.2 {Tk_AllocColorFromObj - discard stale color} {
+ set x green
+ destroy .b1 .b2
+ button .b1 -foreground $x -text First
+ destroy .b1
+ set result {}
+ lappend result [testcolor green]
+ button .b2 -foreground $x -text Second
+ lappend result [testcolor green]
+} {{} {{1 1}}}
+test color-1.3 {Tk_AllocColorFromObj - reuse existing color} {
+ set x green
+ destroy .b1 .b2
+ button .b1 -foreground $x -text First
+ set result {}
+ lappend result [testcolor green]
+ button .b2 -foreground $x -text Second
+ pack .b1 .b2 -side top
+ lappend result [testcolor green]
+} {{{1 1}} {{2 1}}}
+test color-1.4 {Tk_AllocColorFromObj - try other colors in list} {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -foreground $x -text First
+ pack .b1 -side top
+ set result {}
+ lappend result [testcolor purple]
+ button .t.b -foreground $x -text Second
+ pack .t.b -side top
+ lappend result [testcolor purple]
+ button .b2 -foreground $x -text Third
+ pack .b2 -side top
+ lappend result [testcolor purple]
+} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}
+
+test color-2.1 {Tk_GetColor procedure} {
+ c255 [winfo rgb .t #FF0000]
} {255 0 0}
-test color-1.2 {Tk_GetColor procedure} {
+test color-2.2 {Tk_GetColor procedure} {
list [catch {winfo rgb .t noname} msg] $msg
} {1 {unknown color name "noname"}}
-
-test color-1.3 {Tk_GetColor procedure} {
+test color-2.3 {Tk_GetColor procedure} {
c255 [winfo rgb .t #123456]
} {18 52 86}
-test color-1.4 {Tk_GetColor procedure} {
+test color-2.4 {Tk_GetColor procedure} {
list [catch {winfo rgb .t #xyz} msg] $msg
} {1 {invalid color name "#xyz"}}
+test color-2.5 {Tk_GetColor procedure} {
+ winfo rgb .t #00FF00
+} {0 65535 0}
+test color-2.6 {Tk_GetColor procedure} {
+ winfo rgb .t red
+} {65535 0 0}
-test color-2.1 {Tk_FreeColor procedure, reference counting} {
+test color-3.1 {Tk_FreeColor procedure, reference counting} {
eval destroy [winfo child .t]
mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
pack .t.c
@@ -153,7 +210,7 @@ test color-2.1 {Tk_FreeColor procedure, reference counting} {
.t.c2 delete $last
lappend result [colorsFree .t]
} {0 1}
-test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
+test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
eval destroy [winfo child .t]
mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
pack .t.c
@@ -163,5 +220,74 @@ test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
update
closest .t 241 241 1
} {240 240 0}
+test color-3.3 {Tk_FreeColorFromObj - reference counts} {
+ set x purple
+ destroy .b1 .b2 .t.b
+ button .b1 -foreground $x -text First
+ pack .b1 -side top
+ button .t.b -foreground $x -text Second
+ pack .t.b -side top
+ button .b2 -foreground $x -text Third
+ pack .b2 -side top
+ set result {}
+ lappend result [testcolor purple]
+ destroy .b1
+ lappend result [testcolor purple]
+ destroy .b2
+ lappend result [testcolor purple]
+ destroy .t.b
+ lappend result [testcolor purple]
+} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
+test color-3.4 {Tk_FreeColorFromObj - unlinking from list} {
+ destroy .b .t.b .t2 .t3
+ toplevel .t2 -visual {pseudocolor 8} -colormap new
+ toplevel .t3 -visual {pseudocolor 8} -colormap new
+ set x purple
+ button .b -foreground $x -text .b1
+ button .t.b1 -foreground $x -text .t.b1
+ button .t.b2 -foreground $x -text .t.b2
+ button .t2.b1 -foreground $x -text .t2.b1
+ button .t2.b2 -foreground $x -text .t2.b2
+ button .t2.b3 -foreground $x -text .t2.b3
+ button .t3.b1 -foreground $x -text .t3.b1
+ button .t3.b2 -foreground $x -text .t3.b2
+ button .t3.b3 -foreground $x -text .t3.b3
+ button .t3.b4 -foreground $x -text .t3.b4
+ set result {}
+ lappend result [testcolor purple]
+ destroy .t2
+ lappend result [testcolor purple]
+ destroy .b
+ lappend result [testcolor purple]
+ destroy .t3
+ lappend result [testcolor purple]
+ destroy .t
+ lappend result [testcolor purple]
+} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
+test color-4.1 {FreeColorObjProc} {
+ destroy .b
+ set x [format purple]
+ button .b -foreground $x -text .b1
+ set y [format purple]
+ .b configure -foreground $y
+ set z [format purple]
+ .b configure -foreground $z
+ set result {}
+ lappend result [testcolor purple]
+ set x red
+ lappend result [testcolor purple]
+ set z 32
+ lappend result [testcolor purple]
+ destroy .b
+ lappend result [testcolor purple]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/config.test b/tk/tests/config.test
new file mode 100644
index 00000000000..f5e4b0c6699
--- /dev/null
+++ b/tk/tests/config.test
@@ -0,0 +1,838 @@
+# 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info command testobjconfig] != "testobjconfig"} {
+ puts "This application hasn't been compiled with the \"testobjconfig\""
+ puts "command, so I can't run this test. Are you sure you're using"
+ puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
+ return
+}
+
+proc killTables {} {
+ # Note: it's important to delete chain2 before chain1, because
+ # chain2 depends on chain1. If chain1 is deleted first, the
+ # delete of chain2 will crash.
+
+ foreach t {alltypes chain2 chain1 configerror internal new notenoughparams
+ twowindows} {
+ while {[testobjconfig info $t] != ""} {
+ testobjconfig delete $t
+ }
+ }
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+killTables
+wm geometry . {}
+raise .
+
+test config-1.1 {Tk_CreateOptionTable - reference counts} {
+ eval destroy [winfo children .]
+ killTables
+ set x {}
+ testobjconfig alltypes .a
+ lappend x [testobjconfig info alltypes]
+ testobjconfig alltypes .b
+ lappend x [testobjconfig info alltypes]
+ eval destroy [winfo children .]
+ set x
+} {{1 15 -boolean} {2 15 -boolean}}
+test config-1.2 {Tk_CreateOptionTable - synonym initialization} {
+ eval destroy [winfo children .]
+ testobjconfig alltypes .a -synonym green
+ .a cget -color
+} {green}
+test config-1.3 {Tk_CreateOptionTable - option database initialization} {
+ eval destroy [winfo children .]
+ option clear
+ testobjconfig alltypes .a
+ option add *b.string different
+ testobjconfig alltypes .b
+ list [.a cget -string] [.b cget -string]
+} {foo different}
+test config-1.4 {Tk_CreateOptionTable - option database initialization} {
+ eval destroy [winfo children .]
+ option clear
+ testobjconfig alltypes .a
+ option add *b.String bar
+ testobjconfig alltypes .b
+ list [.a cget -string] [.b cget -string]
+} {foo bar}
+test config-1.5 {Tk_CreateOptionTable - default initialization} {
+ eval destroy [winfo children .]
+ testobjconfig alltypes .a
+ .a cget -relief
+} {raised}
+test config-1.6 {Tk_CreateOptionTable - chained tables} {
+ eval destroy [winfo children .]
+ killTables
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ testobjconfig info chain2
+} {1 4 -three 2 2 -one}
+test config-1.7 {Tk_CreateOptionTable - chained tables} {
+ eval destroy [winfo children .]
+ killTables
+ testobjconfig chain2 .b
+ testobjconfig chain1 .a
+ testobjconfig info chain2
+} {1 4 -three 2 2 -one}
+test config-1.8 {Tk_CreateOptionTable - chained tables} {
+ eval destroy [winfo children .]
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ list [catch {.a cget -four} msg] $msg [.a cget -one] \
+ [.b cget -four] [.b cget -one]
+} {1 {unknown option "-four"} one four one}
+
+test config-2.1 {Tk_DeleteOptionTable - reference counts} {
+ eval destroy [winfo children .]
+ killTables
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ testobjconfig chain2 .c
+ eval destroy [winfo children .]
+ set x {}
+ testobjconfig delete chain2
+ lappend x [testobjconfig info chain2] [testobjconfig info chain1]
+ testobjconfig delete chain2
+ lappend x [testobjconfig info chain2] [testobjconfig info chain1]
+} {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}}
+
+# No tests for DestroyOptionHashTable; couldn't figure out how to test.
+
+test config-3.1 {Tk_InitOptions - priority of chained tables} {
+ eval destroy [winfo children .]
+ testobjconfig chain1 .a
+ testobjconfig chain2 .b
+ list [.a cget -two] [.b cget -two]
+} {two {two and a half}}
+test config-3.2 {Tk_InitOptions - initialize from database} {
+ eval destroy [winfo children .]
+ option clear
+ option add *a.color blue
+ testobjconfig alltypes .a
+ list [.a cget -color]
+} {blue}
+test config-3.3 {Tk_InitOptions - initialize from database} {
+ eval destroy [winfo children .]
+ option clear
+ option add *a.justify bogus
+ testobjconfig alltypes .a
+ list [.a cget -justify]
+} {left}
+test config-3.4 {Tk_InitOptions - initialize from widget class} {
+ eval destroy [winfo children .]
+ testobjconfig alltypes .a
+ list [.a cget -color]
+} {red}
+test config-3.5 {Tk_InitOptions - no initial value} {
+ eval destroy [winfo children .]
+ testobjconfig alltypes .a
+ .a cget -anchor
+} {}
+test config-3.6 {Tk_InitOptions - bad initial value} {
+ eval destroy [winfo children .]
+ option clear
+ option add *a.color non-existent
+ list [catch {testobjconfig alltypes .a} msg] $msg $errorInfo
+} {1 {unknown color name "non-existent"} {unknown color name "non-existent"
+ (database entry for "-color" in widget ".a")
+ invoked from within
+"testobjconfig alltypes .a"}}
+option clear
+test config-3.7 {Tk_InitOptions - bad initial value} {
+ eval destroy [winfo children .]
+ list [catch {testobjconfig configerror} msg] $msg $errorInfo
+} {1 {expected integer but got "bogus"} {expected integer but got "bogus"
+ (default value for "-int")
+ invoked from within
+"testobjconfig configerror"}}
+option clear
+
+test config-4.1 {DoObjConfig - boolean} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -boolean 0} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 0 0}
+test config-4.2 {DoObjConfig - boolean} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -boolean 1} msg] $msg [catch {.foo cget -boolean} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 1 0}
+test config-4.3 {DoObjConfig - invalid boolean} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -boolean {}} msg] $msg
+} {1 {expected boolean value but got ""}}
+test config-4.4 {DoObjConfig - boolean internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -boolean 0
+ .foo cget -boolean
+} {0}
+test config-4.5 {DoObjConfig - integer} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -integer 3} msg] $msg [catch {.foo cget -integer} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 3 0}
+test config-4.6 {DoObjConfig - invalid integer} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -integer bar} msg] $msg
+} {1 {expected integer but got "bar"}}
+test config-4.7 {DoObjConfig - integer internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -integer 421
+ .foo cget -integer
+} {421}
+test config-4.8 {DoObjConfig - double} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -double 3.14} msg] $msg [catch {.foo cget -double} result] $result [catch {rename .foo {}}]
+} {0 .foo 0 3.14 0}
+test config-4.9 {DoObjConfig - invalid double} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -double bar} msg] $msg
+} {1 {expected floating-point number but got "bar"}}
+test config-4.10 {DoObjConfig - double internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -double 62.75
+ .foo cget -double
+} {62.75}
+test config-4.11 {DoObjConfig - string} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -string test} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
+} {0 .foo 0 test {}}
+test config-4.12 {DoObjConfig - null string} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -string {}} msg] $msg [catch {.foo cget -string} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.13 {DoObjConfig - string internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -string "this is a test"
+ .foo cget -string
+} {this is a test}
+test config-4.14 {DoObjConfig - string table} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -stringtable two} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
+} {0 .foo 0 two {}}
+test config-4.15 {DoObjConfig - invalid string table} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -stringtable foo} msg] $msg
+} {1 {bad stringtable "foo": must be one, two, three, or four}}
+test config-4.16 {DoObjConfig - new string table} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -stringtable two
+ list [catch {.foo configure -stringtable three} msg] $msg [catch {.foo cget -stringtable} result] $result [destroy .foo]
+} {0 16 0 three {}}
+test config-4.17 {DoObjConfig - stringtable internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -stringtable "four"
+ .foo cget -stringtable
+} {four}
+test config-4.18 {DoObjConfig - color} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -color blue} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 .foo 0 blue {}}
+test config-4.19 {DoObjConfig - invalid color} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -color xxx} msg] $msg
+} {1 {unknown color name "xxx"}}
+test config-4.20 {DoObjConfig - color internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -color purple
+ .foo cget -color
+} {purple}
+test config-4.21 {DoObjConfig - null color} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -color {}} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.22 {DoObjConfig - getting rid of old color} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -color #333333
+ list [catch {.foo configure -color #444444} msg] $msg [catch {.foo cget -color} result] $result [destroy .foo]
+} {0 32 0 #444444 {}}
+test config-4.23 {DoObjConfig - font} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 .foo 0 {Helvetica 72} {}}
+test config-4.24 {DoObjConfig - new font} {
+ catch {rename .foo {}}
+ testobjconfig alltypes .foo -font {Courier 12}
+ list [catch {.foo configure -font {Helvetica 72}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 64 0 {Helvetica 72} {}}
+test config-4.25 {DoObjConfig - invalid font} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -font {Helvetica 12 foo}} msg] $msg
+} {1 {unknown font style "foo"}}
+test config-4.26 {DoObjConfig - null font} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -font {}} msg] $msg [catch {.foo cget -font} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.27 {DoObjConfig - font internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -font {Times 16}
+ .foo cget -font
+} {Times 16}
+test config-4.28 {DoObjConfig - bitmap} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -bitmap gray75} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 .foo 0 gray75 {}}
+test config-4.29 {DoObjConfig - new bitmap} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -bitmap gray75
+ list [catch {.foo configure -bitmap gray50} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 128 0 gray50 {}}
+test config-4.30 {DoObjConfig - invalid bitmap} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -bitmap foo} msg] $msg
+} {1 {bitmap "foo" not defined}}
+test config-4.31 {DoObjConfig - null bitmap} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -bitmap {}} msg] $msg [catch {.foo cget -bitmap} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.32 {DoObjConfig - bitmap internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -bitmap gray25
+ .foo cget -bitmap
+} {gray25}
+test config-4.33 {DoObjConfig - border} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -border green} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 .foo 0 green {}}
+test config-4.34 {DoObjConfig - invalid border} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -border xxx} msg] $msg
+} {1 {unknown color name "xxx"}}
+test config-4.35 {DoObjConfig - null border} {
+ catch {rename .foo {}}
+ list [catch {testobjconfig alltypes .foo -border {}} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.36 {DoObjConfig - border internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -border #123456
+ .foo cget -border
+} {#123456}
+test config-4.37 {DoObjConfig - getting rid of old border} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -border #333333
+ list [catch {.foo configure -border #444444} msg] $msg [catch {.foo cget -border} result] $result [destroy .foo]
+} {0 256 0 #444444 {}}
+test config-4.38 {DoObjConfig - relief} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
+} {0 .foo 0 flat {}}
+test config-4.39 {DoObjConfig - invalid relief} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -relief foo} msg] $msg
+} {1 {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken}}
+test config-4.40 {DoObjConfig - new relief} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -relief raised
+ list [catch {.foo configure -relief flat} msg] $msg [catch {.foo cget -relief} result] $result [destroy .foo]
+} {0 512 0 flat {}}
+test config-4.41 {DoObjConfig - relief internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -relief ridge
+ .foo cget -relief
+} {ridge}
+test config-4.42 {DoObjConfig - cursor} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 .foo 0 arrow {}}
+test config-4.43 {DoObjConfig - invalid cursor} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -cursor foo} msg] $msg
+} {1 {bad cursor spec "foo"}}
+test config-4.44 {DoObjConfig - null cursor} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -cursor {}} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.45 {DoObjConfig - new cursor} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -cursor xterm
+ list [catch {.foo configure -cursor arrow} msg] $msg [catch {.foo cget -cursor} result] $result [destroy .foo]
+} {0 1024 0 arrow {}}
+test config-4.46 {DoObjConfig - cursor internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -cursor watch
+ .foo cget -cursor
+} {watch}
+test config-4.47 {DoObjConfig - justify} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -justify center} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
+} {0 .foo 0 center {}}
+test config-4.48 {DoObjConfig - invalid justify} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -justify foo} msg] $msg
+} {1 {bad justification "foo": must be left, right, or center}}
+test config-4.49 {DoObjConfig - new justify} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -justify left
+ list [catch {.foo configure -justify right} msg] $msg [catch {.foo cget -justify} result] $result [destroy .foo]
+} {0 2048 0 right {}}
+test config-4.50 {DoObjConfig - justify internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -justify center
+ .foo cget -justify
+} {center}
+test config-4.51 {DoObjConfig - anchor} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -anchor center} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
+} {0 .foo 0 center {}}
+test config-4.52 {DoObjConfig - invalid anchor} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -anchor foo} msg] $msg
+} {1 {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center}}
+test config-4.53 {DoObjConfig - new anchor} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -anchor e
+ list [catch {.foo configure -anchor n} msg] $msg [catch {.foo cget -anchor} result] $result [destroy .foo]
+} {0 4096 0 n {}}
+test config-4.54 {DoObjConfig - anchor internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -anchor sw
+ .foo cget -anchor
+} {sw}
+test config-4.55 {DoObjConfig - pixel} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -pixel 42} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
+} {0 .foo 0 42 {}}
+test config-4.56 {DoObjConfig - invalid pixel} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -pixel foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+test config-4.57 {DoObjConfig - new pixel} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -pixel 42m
+ list [catch {.foo configure -pixel 3c} msg] $msg [catch {.foo cget -pixel} result] $result [destroy .foo]
+} {0 8192 0 3c {}}
+test config-4.58 {DoObjConfig - pixel internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -pixel [winfo screenmmwidth .]m
+ .foo cget -pixel
+} [winfo screenwidth .]
+test config-4.59 {DoObjConfig - window} {
+ catch {destroy .foo}
+ catch {destroy .bar}
+ toplevel .bar
+ list [catch {testobjconfig twowindows .foo -window .bar} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar]
+} {0 .foo 0 .bar {} {}}
+test config-4.60 {DoObjConfig - invalid window} {
+ catch {destroy .foo}
+ toplevel .bar
+ list [catch {testobjconfig twowindows .foo -window foo} msg] $msg [destroy .bar]
+} {1 {bad window path name "foo"} {}}
+test config-4.61 {DoObjConfig - null window} {
+ catch {destroy .foo}
+ catch {destroy .bar}
+ toplevel .bar
+ list [catch {testobjconfig twowindows .foo -window {}} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo]
+} {0 .foo 0 {} {}}
+test config-4.62 {DoObjConfig - new window} {
+ catch {destroy .foo}
+ catch {destroy .bar}
+ catch {destroy .blamph}
+ toplevel .bar
+ toplevel .blamph
+ testobjconfig twowindows .foo -window .bar
+ list [catch {.foo configure -window .blamph} msg] $msg [catch {.foo cget -window} result] $result [destroy .foo] [destroy .bar] [destroy .blamph]
+} {0 0 0 .blamph {} {} {}}
+test config-4.63 {DoObjConfig - window internal value} {
+ catch {rename .foo {}}
+ testobjconfig internal .foo -window .
+ .foo cget -window
+} {.}
+test config-4.64 {DoObjConfig - releasing old values} {
+ # This test doesn't generate a useful value to check; if an
+ # error occurs, it will be detected only by memory checking software
+ # such as Purify or Tcl's built-in checker.
+
+ catch {rename .foo {}}
+ testobjconfig alltypes .foo -string {Test string} -color yellow \
+ -font {Courier 18} -bitmap questhead -border green -cursor cross
+ .foo configure -string {new string} -color brown \
+ -font {Times 8} -bitmap gray75 -border pink -cursor watch
+ concat {}
+} {}
+test config-4.65 {DoObjConfig - releasing old values} {
+ # This test doesn't generate a useful value to check; if an
+ # error occurs, it will be detected only by memory checking software
+ # such as Purify or Tcl's built-in checker.
+
+ catch {rename .foo {}}
+ testobjconfig internal .foo -string {Test string} -color yellow \
+ -font {Courier 18} -bitmap questhead -border green -cursor cross
+ .foo configure -string {new string} -color brown \
+ -font {Times 8} -bitmap gray75 -border pink -cursor watch
+ concat {}
+} {}
+
+test config-5.1 {ObjectIsEmpty - object is already string} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -color [format ""]
+ .foo cget -color
+} {}
+test config-5.2 {ObjectIsEmpty - object is already string} {
+ catch {destroy .foo}
+ list [catch {testobjconfig alltypes .foo -color [format " "]} msg] $msg
+} {1 {unknown color name " "}}
+test config-5.3 {ObjectIsEmpty - must convert back to string} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -color [list]
+ .foo cget -color
+} {}
+
+eval destroy [winfo children .]
+testobjconfig chain2 .a
+testobjconfig alltypes .b
+test config-6.1 {GetOptionFromObj - cached answer} {
+ list [.a cget -three] [.a cget -three]
+} {three three}
+test config-6.2 {GetOptionFromObj - exact match} {
+ .a cget -one
+} {one}
+test config-6.3 {GetOptionFromObj - abbreviation} {
+ .a cget -fo
+} {four}
+test config-6.4 {GetOptionFromObj - ambiguous abbreviation} {
+ list [catch {.a cget -on} msg] $msg
+} {1 {unknown option "-on"}}
+test config-6.5 {GetOptionFromObj - duplicate options in different tables} {
+ .a cget -tw
+} {two and a half}
+test config-6.6 {GetOptionFromObj - synonym} {
+ .b cget -synonym
+} {red}
+
+eval destroy [winfo children .]
+testobjconfig alltypes .a
+test config-7.1 {Tk_SetOptions - basics} {
+ .a configure -color green -rel sunken
+ list [.a cget -color] [.a cget -relief]
+} {green sunken}
+test config-7.2 {Tk_SetOptions - bogus option name} {
+ list [catch {.a configure -bogus} msg] $msg
+} {1 {unknown option "-bogus"}}
+test config-7.3 {Tk_SetOptions - synonym} {
+ .a configure -synonym blue
+ .a cget -color
+} {blue}
+test config-7.4 {Tk_SetOptions - missing value} {
+ list [catch {.a configure -color green -relief} msg] $msg [.a cget -color]
+} {1 {value for "-relief" missing} green}
+test config-7.5 {Tk_SetOptions - saving old values} {
+ .a configure -color red -int 7 -relief raised -double 3.14159
+ list [catch {.a csave -color green -int 432 -relief sunken \
+ -double 2.0 -color bogus} msg] $msg [.a cget -color] \
+ [.a cget -int] [.a cget -relief] [.a cget -double]
+} {1 {unknown color name "bogus"} red 7 raised 3.14159}
+test config-7.6 {Tk_SetOptions - error in DoObjConfig call} {
+ list [catch {.a configure -color bogus} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+ (processing "-color" option)
+ invoked from within
+".a configure -color bogus"}}
+test config-7.7 {Tk_SetOptions - synonym name in error message} {
+ list [catch {.a configure -synonym bogus} msg] $msg $errorInfo
+} {1 {unknown color name "bogus"} {unknown color name "bogus"
+ (processing "-synonym" option)
+ invoked from within
+".a configure -synonym bogus"}}
+test config-7.8 {Tk_SetOptions - returning mask} {
+ format %x [.a configure -color red -int 7 -relief raised -double 3.14159]
+} {226}
+
+test config-8.1 {Tk_RestoreSavedOptions - restore in proper order} {
+ eval destroy [winfo children .]
+ testobjconfig alltypes .a
+ list [catch {.a csave -color green -color black -color blue \
+ -color #ffff00 -color #ff00ff -color bogus} msg] $msg \
+ [.a cget -color]
+} {1 {unknown color name "bogus"} red}
+test config-8.2 {Tk_RestoreSavedOptions - freeing object memory} {
+ eval destroy [winfo children .]
+ testobjconfig alltypes .a
+ .a csave -color green -color black -color blue -color #ffff00 \
+ -color #ff00ff
+} {32}
+test config-8.3 {Tk_RestoreSavedOptions - boolean internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -boolean 0 -color bogus}] [.a cget -boolean]
+} {1 1}
+test config-8.4 {Tk_RestoreSavedOptions - integer internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -integer 24 -color bogus}] [.a cget -integer]
+} {1 148962237}
+test config-8.5 {Tk_RestoreSavedOptions - double internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -double 62.4 -color bogus}] [.a cget -double]
+} {1 3.14159}
+test config-8.6 {Tk_RestoreSavedOptions - string internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -string "A long string" -color bogus}] \
+ [.a cget -string]
+} {1 foo}
+test config-8.7 {Tk_RestoreSavedOptions - string table internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -stringtable three -color bogus}] \
+ [.a cget -stringtable]
+} {1 one}
+test config-8.8 {Tk_RestoreSavedOptions - color internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -color green -color bogus}] [.a cget -color]
+} {1 red}
+test config-8.9 {Tk_RestoreSavedOptions - font internal form} {nonPortable} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -font {Times 12} -color bogus}] [.a cget -font]
+} {1 {Helvetica 12}}
+test config-8.10 {Tk_RestoreSavedOptions - bitmap internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -bitmap questhead -color bogus}] [.a cget -bitmap]
+} {1 gray50}
+test config-8.11 {Tk_RestoreSavedOptions - border internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -border brown -color bogus}] [.a cget -border]
+} {1 blue}
+test config-8.12 {Tk_RestoreSavedOptions - relief internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -relief sunken -color bogus}] [.a cget -relief]
+} {1 raised}
+test config-8.13 {Tk_RestoreSavedOptions - cursor internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -cursor watch -color bogus}] [.a cget -cursor]
+} {1 xterm}
+test config-8.14 {Tk_RestoreSavedOptions - justify internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -justify right -color bogus}] [.a cget -justify]
+} {1 left}
+test config-8.15 {Tk_RestoreSavedOptions - anchor internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a
+ list [catch {.a csave -anchor center -color bogus}] [.a cget -anchor]
+} {1 n}
+test config-8.16 {Tk_RestoreSavedOptions - window internal form} {
+ eval destroy [winfo children .]
+ testobjconfig internal .a -window .a
+ list [catch {.a csave -window .a -color bogus}] [.a cget -window]
+} {1 .a}
+
+# Most of the tests below will cause memory leakage if there is a
+# problem. This may not be evident unless the tests are run in
+# conjunction with a memory usage analyzer such as Purify.
+
+test config-9.1 {Tk_FreeConfigOptions/FreeResources - string internal form} {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -string "two words"
+ destroy .foo
+} {}
+test config-9.2 {Tk_FreeConfigOptions/FreeResources - color internal form} {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -color yellow
+ destroy .foo
+} {}
+test config-9.3 {Tk_FreeConfigOptions/FreeResources - color} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -color [format blue]
+ destroy .foo
+} {}
+test config-9.4 {Tk_FreeConfigOptions/FreeResources - font internal form} {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -font {Courier 20}
+ destroy .foo
+} {}
+test config-9.5 {Tk_FreeConfigOptions/FreeResources - font} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -font [format {Courier 24}]
+ destroy .foo
+} {}
+test config-9.6 {Tk_FreeConfigOptions/FreeResources - bitmap internal form} {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -bitmap gray75
+ destroy .foo
+} {}
+test config-9.7 {Tk_FreeConfigOptions/FreeResources - bitmap} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -bitmap [format gray75]
+ destroy .foo
+} {}
+test config-9.8 {Tk_FreeConfigOptions/FreeResources - border internal form} {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -border orange
+ destroy .foo
+} {}
+test config-9.9 {Tk_FreeConfigOptions/FreeResources - border} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -border [format blue]
+ destroy .foo
+} {}
+test config-9.10 {Tk_FreeConfigOptions/FreeResources - cursor internal form} {
+ catch {destroy .foo}
+ testobjconfig internal .foo
+ .foo configure -cursor cross
+ destroy .foo
+} {}
+test config-9.11 {Tk_FreeConfigOptions/FreeResources - cursor} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -cursor [format watch]
+ destroy .foo
+} {}
+test config-9.12 {Tk_FreeConfigOptions/FreeResources - not special} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -integer [format 27]
+ destroy .foo
+} {}
+
+test config-10.1 {Tk_GetOptionInfo - one item} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -relief groove
+ .foo configure -relief
+} {-relief relief Relief raised groove}
+test config-10.2 {Tk_GetOptionInfo - one item, synonym} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo
+ .foo configure -color black
+ .foo configure -synonym
+} {-color color Color red black}
+test config-10.3 {Tk_GetOptionInfo - all items} {
+ catch {destroy .foo}
+ testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563
+ .foo configure
+} {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-pixel pixel Pixel 1 1} {-synonym -color}}
+test config-10.4 {Tk_GetOptionInfo - chaining through tables} {
+ catch {destroy .foo}
+ testobjconfig chain2 .foo -one asdf -three xyzzy
+ .foo configure
+} {{-three three Three three xyzzy} {-four four Four four four} {-two two Two {two and a half} {two and a half}} {-oneAgain oneAgain OneAgain {one again} {one again}} {-one one One one asdf} {-two two Two two {two and a half}}}
+
+eval destroy [winfo children .]
+testobjconfig alltypes .a
+test config-11.1 {GetConfigList - synonym} {
+ lindex [.a configure] end
+} {-synonym -color}
+test config-11.2 {GetConfigList - null database names} {
+ .a configure -justify
+} {-justify {} {} left left}
+test config-11.3 {GetConfigList - null default and current value} {
+ .a configure -anchor
+} {-anchor anchor Anchor {} {}}
+
+eval destroy [winfo children .]
+testobjconfig internal .a
+test config-12.1 {GetObjectForOption - boolean} {
+ .a configure -boolean 0
+ .a cget -boolean
+} {0}
+test config-12.2 {GetObjectForOption - integer} {
+ .a configure -integer 1247
+ .a cget -integer
+} {1247}
+test config-12.3 {GetObjectForOption - double} {
+ .a configure -double -88.82
+ .a cget -double
+} {-88.82}
+test config-12.4 {GetObjectForOption - string} {
+ .a configure -string "test value"
+ .a cget -string
+} {test value}
+test config-12.5 {GetObjectForOption - stringTable} {
+ .a configure -stringtable "two"
+ .a cget -stringtable
+} {two}
+test config-12.6 {GetObjectForOption - color} {
+ .a configure -color "green"
+ .a cget -color
+} {green}
+test config-12.7 {GetObjectForOption - font} {
+ .a configure -font {Times 36}
+ .a cget -font
+} {Times 36}
+test config-12.8 {GetObjectForOption - bitmap} {
+ .a configure -bitmap "questhead"
+ .a cget -bitmap
+} {questhead}
+test config-12.9 {GetObjectForOption - border} {
+ .a configure -border #33217c
+ .a cget -border
+} {#33217c}
+test config-12.10 {GetObjectForOption - relief} {
+ .a configure -relief groove
+ .a cget -relief
+} {groove}
+test config-12.11 {GetObjectForOption - cursor} {
+ .a configure -cursor watch
+ .a cget -cursor
+} {watch}
+test config-12.12 {GetObjectForOption - justify} {
+ .a configure -justify right
+ .a cget -justify
+} {right}
+test config-12.13 {GetObjectForOption - anchor} {
+ .a configure -anchor e
+ .a cget -anchor
+} {e}
+test config-12.14 {GetObjectForOption - pixels} {
+ .a configure -pixel 193.2
+ .a cget -pixel
+} {193}
+test config-12.15 {GetObjectForOption - window} {
+ .a configure -window .a
+ .a cget -window
+} {.a}
+test config-12.16 {GetObjectForOption - null values} {
+ .a configure -string {} -color {} -font {} -bitmap {} -border {} \
+ -cursor {} -window {}
+ list [.a cget -string] [.a cget -color] [.a cget -font] \
+ [.a cget -string] [.a cget -bitmap] [.a cget -border] \
+ [.a cget -cursor] [.a cget -window]
+} {{} {} {} {} {} {} {} {}}
+
+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
+ }
+} {}
+
+# cleanup
+eval destroy [winfo children .]
+killTables
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/cursor.test b/tk/tests/cursor.test
new file mode 100644
index 00000000000..a0e80f14a95
--- /dev/null
+++ b/tk/tests/cursor.test
@@ -0,0 +1,116 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkCursor.c. It is organized in the standard white-box fashion for
+# Tcl tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testcursor] != "testcursor"} {
+ puts "testcursor command not available; skipping tests"
+ ::tcltest::cleanupTests
+ return
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+test cursor-1.1 {Tk_AllocCursorFromObj - converting internal reps} {
+ set x watch
+ lindex $x 0
+ destroy .b1
+ button .b1 -cursor $x
+ lindex $x 0
+ testcursor watch
+} {{1 0}}
+test cursor-1.2 {Tk_AllocCursorFromObj - discard stale cursor} {
+ set x watch
+ destroy .b1 .b2
+ button .b1 -cursor $x
+ destroy .b1
+ set result {}
+ lappend result [testcursor watch]
+ button .b2 -cursor $x
+ lappend result [testcursor watch]
+} {{} {{1 1}}}
+test cursor-1.3 {Tk_AllocCursorFromObj - reuse existing cursor} {
+ set x watch
+ destroy .b1 .b2
+ button .b1 -cursor $x
+ set result {}
+ lappend result [testcursor watch]
+ button .b2 -cursor $x
+ pack .b1 .b2 -side top
+ lappend result [testcursor watch]
+} {{{1 1}} {{2 1}}}
+
+test cursor-2.1 {Tk_GetCursor procedure} {
+ destroy .b1
+ list [catch {button .b1 -cursor bad_name} msg] $msg
+} {1 {bad cursor spec "bad_name"}}
+test cursor-2.2 {Tk_GetCursor procedure} {
+ destroy .b1
+ list [catch {button .b1 -cursor @xyzzy} msg] $msg
+} {1 {bad cursor spec "@xyzzy"}}
+
+test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} {
+ set x arrow
+ destroy .b1 .b2 .b3
+ button .b1 -cursor $x
+ button .b3 -cursor $x
+ button .b2 -cursor $x
+ set result {}
+ lappend result [testcursor arrow]
+ destroy .b1
+ lappend result [testcursor arrow]
+ destroy .b2
+ lappend result [testcursor arrow]
+ destroy .b3
+ lappend result [testcursor arrow]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+
+test cursor-4.1 {FreeCursorObjProc} {
+ destroy .b
+ set x [format arrow]
+ button .b -cursor $x
+ set y [format arrow]
+ .b configure -cursor $y
+ set z [format arrow]
+ .b configure -cursor $z
+ set result {}
+ lappend result [testcursor arrow]
+ set x red
+ lappend result [testcursor arrow]
+ set z 32
+ lappend result [testcursor arrow]
+ destroy .b
+ lappend result [testcursor arrow]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+destroy .t
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/defs.tcl b/tk/tests/defs.tcl
new file mode 100644
index 00000000000..a2e55cdbb6a
--- /dev/null
+++ b/tk/tests/defs.tcl
@@ -0,0 +1,1097 @@
+# defs.tcl --
+#
+# This file contains support code for the Tcl/Tk test suite.It is
+# It is normally sourced by the individual files in the test suite
+# before they run their tests. This improved approach to testing
+# was designed and initially implemented by Mary Ann May-Pumphrey
+# of Sun Microsystems.
+#
+# Copyright (c) 1990-1994 The Regents of the University of California.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+# Initialize wish shell
+
+if {[info exists tk_version]} {
+ tk appname tktest
+ wm title . tktest
+} else {
+
+ # Ensure that we have a minimal auto_path so we don't pick up extra junk.
+
+ set auto_path [list [info library]]
+}
+
+# create the "tcltest" namespace for all testing variables and procedures
+
+namespace eval tcltest {
+ set procList [list test cleanupTests dotests saveState restoreState \
+ normalizeMsg makeFile removeFile makeDirectory removeDirectory \
+ viewFile bytestring set_iso8859_1_locale restore_locale \
+ safeFetch threadReap]
+ if {[info exists tk_version]} {
+ lappend procList setupbg dobg bgReady cleanupbg fixfocus
+ }
+ foreach proc $procList {
+ namespace export $proc
+ }
+
+ # setup ::tcltest default vars
+ foreach {var default} {verbose b match {} skip {}} {
+ if {![info exists $var]} {
+ variable $var $default
+ }
+ }
+
+ # Tests should not rely on the current working directory.
+ # Files that are part of the test suite should be accessed relative to
+ # ::tcltest::testsDir.
+
+ set originalDir [pwd]
+ set tDir [file join $originalDir [file dirname [info script]]]
+ cd $tDir
+ variable testsDir [pwd]
+ cd $originalDir
+
+ # Count the number of files tested (0 if all.tcl wasn't called).
+ # The all.tcl file will set testSingleFile to false, so stats will
+ # not be printed until all.tcl calls the cleanupTests proc.
+ # The currentFailure var stores the boolean value of whether the
+ # current test file has had any failures. The failFiles list
+ # stores the names of test files that had failures.
+
+ variable numTestFiles 0
+ variable testSingleFile true
+ variable currentFailure false
+ variable failFiles {}
+
+ # Tests should remove all files they create. The test suite will
+ # check the current working dir for files created by the tests.
+ # ::tcltest::filesMade keeps track of such files created using the
+ # ::tcltest::makeFile and ::tcltest::makeDirectory procedures.
+ # ::tcltest::filesExisted stores the names of pre-existing files.
+
+ variable filesMade {}
+ variable filesExisted {}
+
+ # ::tcltest::numTests will store test files as indices and the list
+ # of files (that should not have been) left behind by the test files.
+
+ array set ::tcltest::createdNewFiles {}
+
+ # initialize ::tcltest::numTests array to keep track fo the number of
+ # tests that pass, fial, and are skipped.
+
+ array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
+
+ # initialize ::tcltest::skippedBecause array to keep track of
+ # constraints that kept tests from running
+
+ array set ::tcltest::skippedBecause {}
+
+ # tests that use thread need to know which is the main thread
+
+ variable ::tcltest::mainThread 1
+ if {[info commands testthread] != {}} {
+ puts "Tk with threads enabled is known to have problems with X"
+ set ::tcltest::mainThread [testthread names]
+ }
+}
+
+# If there is no "memory" command (because memory debugging isn't
+# enabled), generate a dummy command that does nothing.
+
+if {[info commands memory] == ""} {
+ proc memory args {}
+}
+
+# ::tcltest::initConfig --
+#
+# Check configuration information that will determine which tests
+# to run. To do this, create an array ::tcltest::testConfig. Each
+# element has a 0 or 1 value. If the element is "true" then tests
+# with that constraint will be run, otherwise tests with that constraint
+# will be skipped. See the README file for the list of built-in
+# constraints defined in this procedure.
+#
+# Arguments:
+# none
+#
+# Results:
+# The ::tcltest::testConfig array is reset to have an index for
+# each built-in test constraint.
+
+proc ::tcltest::initConfig {} {
+
+ global tcl_platform tcl_interactive tk_version
+
+ catch {unset ::tcltest::testConfig}
+
+ # The following trace procedure makes it so that we can safely refer to
+ # non-existent members of the ::tcltest::testConfig array without causing an
+ # error. Instead, reading a non-existent member will return 0. This is
+ # necessary because tests are allowed to use constraint "X" without ensuring
+ # that ::tcltest::testConfig("X") is defined.
+
+ trace variable ::tcltest::testConfig r ::tcltest::safeFetch
+
+ proc ::tcltest::safeFetch {n1 n2 op} {
+ if {($n2 != {}) && ([info exists ::tcltest::testConfig($n2)] == 0)} {
+ set ::tcltest::testConfig($n2) 0
+ }
+ }
+
+ set ::tcltest::testConfig(unixOnly) \
+ [expr {$tcl_platform(platform) == "unix"}]
+ set ::tcltest::testConfig(macOnly) \
+ [expr {$tcl_platform(platform) == "macintosh"}]
+ set ::tcltest::testConfig(pcOnly) \
+ [expr {$tcl_platform(platform) == "windows"}]
+
+ set ::tcltest::testConfig(unix) $::tcltest::testConfig(unixOnly)
+ set ::tcltest::testConfig(mac) $::tcltest::testConfig(macOnly)
+ set ::tcltest::testConfig(pc) $::tcltest::testConfig(pcOnly)
+
+ set ::tcltest::testConfig(unixOrPc) \
+ [expr {$::tcltest::testConfig(unix) || $::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(macOrPc) \
+ [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(macOrUnix) \
+ [expr {$::tcltest::testConfig(mac) || $::tcltest::testConfig(unix)}]
+
+ set ::tcltest::testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}]
+ set ::tcltest::testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}]
+
+ # The following config switches are used to mark tests that should work,
+ # but have been temporarily disabled on certain platforms because they don't
+ # and we haven't gotten around to fixing the underlying problem.
+
+ set ::tcltest::testConfig(tempNotPc) [expr {!$::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(tempNotMac) [expr {!$::tcltest::testConfig(mac)}]
+ set ::tcltest::testConfig(tempNotUnix) [expr {!$::tcltest::testConfig(unix)}]
+
+ # The following config switches are used to mark tests that crash on
+ # certain platforms, so that they can be reactivated again when the
+ # underlying problem is fixed.
+
+ set ::tcltest::testConfig(pcCrash) [expr {!$::tcltest::testConfig(pc)}]
+ set ::tcltest::testConfig(macCrash) [expr {!$::tcltest::testConfig(mac)}]
+ set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}]
+
+ # Set the "fonts" constraint for wish apps
+
+ if {[info exists tk_version]} {
+ set ::tcltest::testConfig(fonts) 1
+ catch {destroy .e}
+ entry .e -width 0 -font {Helvetica -12} -bd 1
+ .e insert end "a.bcd"
+ if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} {
+ set ::tcltest::testConfig(fonts) 0
+ }
+ destroy .e
+ catch {destroy .t}
+ text .t -width 80 -height 20 -font {Times -14} -bd 1
+ pack .t
+ .t insert end "This is\na dot."
+ update
+ set x [list [.t bbox 1.3] [.t bbox 2.5]]
+ destroy .t
+ if {[string match {{22 3 6 15} {31 18 [34] 15}} $x] == 0} {
+ set ::tcltest::testConfig(fonts) 0
+ }
+
+ # Test to see if we have are running Unix apps on Exceed,
+ # which won't return font failures (Windows-like), which is
+ # not what we want from ann X server (other Windows X servers
+ # operate as expected)
+
+ set ::tcltest::testConfig(noExceed) 1
+ if {$::tcltest::testConfig(unixOnly) && \
+ [catch {font actual "\{xyz"}] == 0} {
+ puts "Running X app on Exceed, skipping problematic font tests..."
+ set ::tcltest::testConfig(noExceed) 0
+ }
+ }
+
+ # Skip empty tests
+
+ set ::tcltest::testConfig(emptyTest) 0
+
+ # By default, tests that expost known bugs are skipped.
+
+ set ::tcltest::testConfig(knownBug) 0
+
+ # By default, non-portable tests are skipped.
+
+ set ::tcltest::testConfig(nonPortable) 0
+
+ # Some tests require user interaction.
+
+ set ::tcltest::testConfig(userInteraction) 0
+
+ # Some tests must be skipped if the interpreter is not in interactive mode
+
+ set ::tcltest::testConfig(interactive) $tcl_interactive
+
+ # Some tests must be skipped if you are running as root on Unix.
+ # Other tests can only be run if you are running as root on Unix.
+
+ set ::tcltest::testConfig(root) 0
+ set ::tcltest::testConfig(notRoot) 1
+ set user {}
+ if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {($user == "root") || ($user == "")} {
+ set ::tcltest::testConfig(root) 1
+ set ::tcltest::testConfig(notRoot) 0
+ }
+ }
+
+ # Set nonBlockFiles constraint: 1 means this platform supports
+ # setting files into nonblocking mode.
+
+ if {[catch {set f [open defs r]}]} {
+ set ::tcltest::testConfig(nonBlockFiles) 1
+ } else {
+ if {[catch {fconfigure $f -blocking off}] == 0} {
+ set ::tcltest::testConfig(nonBlockFiles) 1
+ } else {
+ set ::tcltest::testConfig(nonBlockFiles) 0
+ }
+ close $f
+ }
+
+ # Set asyncPipeClose constraint: 1 means this platform supports
+ # async flush and async close on a pipe.
+ #
+ # Test for SCO Unix - cannot run async flushing tests because a
+ # potential problem with select is apparently interfering.
+ # (Mark Diekhans).
+
+ if {$tcl_platform(platform) == "unix"} {
+ if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
+ set ::tcltest::testConfig(asyncPipeClose) 0
+ } else {
+ set ::tcltest::testConfig(asyncPipeClose) 1
+ }
+ } else {
+ set ::tcltest::testConfig(asyncPipeClose) 1
+ }
+
+ # Test to see if we have a broken version of sprintf with respect
+ # to the "e" format of floating-point numbers.
+
+ set ::tcltest::testConfig(eformat) 1
+ if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
+ set ::tcltest::testConfig(eformat) 0
+ }
+
+ # Test to see if execed commands such as cat, echo, rm and so forth are
+ # present on this machine.
+
+ set ::tcltest::testConfig(unixExecs) 1
+ if {$tcl_platform(platform) == "macintosh"} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ($tcl_platform(platform) == "windows")} {
+ if {[catch {exec cat defs}] == 1} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec echo hello}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec sh -c echo hello}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec wc defs}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {$::tcltest::testConfig(unixExecs) == 1} {
+ exec echo hello > removeMe
+ if {[catch {exec rm removeMe}] == 1} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec sleep 1}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec fgrep unixExecs defs}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec ps}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec echo abc > removeMe}] == 0) && \
+ ([catch {exec chmod 644 removeMe}] == 1) && \
+ ([catch {exec rm removeMe}] == 0)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -f removeMe}
+ }
+ if {($::tcltest::testConfig(unixExecs) == 1) && \
+ ([catch {exec mkdir removeMe}] == 1)} {
+ set ::tcltest::testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -r removeMe}
+ }
+ }
+}
+
+::tcltest::initConfig
+
+
+# ::tcltest::processCmdLineArgs --
+#
+# Use command line args to set the verbose, skip, and
+# match variables. This procedure must be run after
+# constraints are initialized, because some constraints can be
+# overridden.
+#
+# Arguments:
+# none
+#
+# Results:
+# ::tcltest::verbose is set to <value>
+
+proc ::tcltest::processCmdLineArgs {} {
+ global argv
+
+ # The "argv" var doesn't exist in some cases, so use {}
+ # The "argv" var doesn't exist in some cases.
+
+ if {(![info exists argv]) || ([llength $argv] < 2)} {
+ set flagArray {}
+ } else {
+ set flagArray $argv
+ }
+
+ if {[catch {array set flag $flagArray}]} {
+ puts stderr "Error: odd number of command line args specified:"
+ puts stderr " $argv"
+ exit
+ }
+
+ # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
+ # Note that -verbose cannot be abbreviated to -v in wish because it
+ # conflicts with the wish option -visual.
+
+ foreach arg {-verbose -match -skip -constraints} {
+ set abbrev [string range $arg 0 1]
+ if {([info exists flag($abbrev)]) && \
+ ([lsearch -exact $flagArray $arg] < \
+ [lsearch -exact $flagArray $abbrev])} {
+ set flag($arg) $flag($abbrev)
+ }
+ }
+
+ # Set ::tcltest::workingDir to [pwd].
+ # Save the names of files that already exist in ::tcltest::workingDir.
+
+ set ::tcltest::workingDir [pwd]
+ foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
+ lappend ::tcltest::filesExisted [file tail $file]
+ }
+
+ # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+
+ if {[info exists flag(-verbose)]} {
+ set ::tcltest::verbose $flag(-verbose)
+ }
+
+ # Set ::tcltest::match to the arg of the -match flag, if given
+
+ if {[info exists flag(-match)]} {
+ set ::tcltest::match $flag(-match)
+ }
+
+ # Set ::tcltest::skip to the arg of the -skip flag, if given
+
+ if {[info exists flag(-skip)]} {
+ set ::tcltest::skip $flag(-skip)
+ }
+
+ # Use the -constraints flag, if given, to turn on constraints that are
+ # turned off by default: userInteractive knownBug nonPortable. This
+ # code fragment must be run after constraints are initialized.
+
+ if {[info exists flag(-constraints)]} {
+ foreach elt $flag(-constraints) {
+ set ::tcltest::testConfig($elt) 1
+ }
+ }
+}
+
+::tcltest::processCmdLineArgs
+
+
+# ::tcltest::cleanupTests --
+#
+# Remove files and dirs created using the makeFile and makeDirectory
+# commands since the last time this proc was invoked.
+#
+# Print the names of the files created without the makeFile command
+# since the tests were invoked.
+#
+# Print the number tests (total, passed, failed, and skipped) since the
+# tests were invoked.
+#
+
+proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
+ set tail [file tail [info script]]
+
+ # Remove files and directories created by the :tcltest::makeFile and
+ # ::tcltest::makeDirectory procedures.
+ # Record the names of files in ::tcltest::workingDir that were not
+ # pre-existing, and associate them with the test file that created them.
+
+ if {!$calledFromAllFile} {
+
+ foreach file $::tcltest::filesMade {
+ if {[file exists $file]} {
+ catch {file delete -force $file}
+ }
+ }
+ set currentFiles {}
+ foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
+ lappend currentFiles [file tail $file]
+ }
+ set newFiles {}
+ foreach file $currentFiles {
+ if {[lsearch -exact $::tcltest::filesExisted $file] == -1} {
+ lappend newFiles $file
+ }
+ }
+ set ::tcltest::filesExisted $currentFiles
+ if {[llength $newFiles] > 0} {
+ set ::tcltest::createdNewFiles($tail) $newFiles
+ }
+ }
+
+ if {$calledFromAllFile || $::tcltest::testSingleFile} {
+
+ # print stats
+
+ puts -nonewline stdout "$tail:"
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)"
+ }
+ puts stdout ""
+
+ # print number test files sourced
+ # print names of files that ran tests which failed
+
+ if {$calledFromAllFile} {
+ puts stdout "Sourced $::tcltest::numTestFiles Test Files."
+ set ::tcltest::numTestFiles 0
+ if {[llength $::tcltest::failFiles] > 0} {
+ puts stdout "Files with failing tests: $::tcltest::failFiles"
+ set ::tcltest::failFiles {}
+ }
+ }
+
+ # if any tests were skipped, print the constraints that kept them
+ # from running.
+
+ set constraintList [array names ::tcltest::skippedBecause]
+ if {[llength $constraintList] > 0} {
+ puts stdout "Number of tests skipped for each constraint:"
+ foreach constraint [lsort $constraintList] {
+ puts stdout \
+ "\t$::tcltest::skippedBecause($constraint)\t$constraint"
+ unset ::tcltest::skippedBecause($constraint)
+ }
+ }
+
+ # report the names of test files in ::tcltest::createdNewFiles, and
+ # reset the array to be empty.
+
+ set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
+ if {[llength $testFilesThatTurded] > 0} {
+ puts stdout "Warning: test files left files behind:"
+ foreach testFile $testFilesThatTurded {
+ puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)"
+ unset ::tcltest::createdNewFiles($testFile)
+ }
+ }
+
+ # reset filesMade, filesExisted, and numTests
+
+ set ::tcltest::filesMade {}
+ foreach index [list "Total" "Passed" "Skipped" "Failed"] {
+ set ::tcltest::numTests($index) 0
+ }
+
+ # exit only if running Tk in non-interactive mode
+
+ global tk_version tcl_interactive
+ if {[info exists tk_version] && !$tcl_interactive} {
+ exit
+ }
+ } else {
+
+ # if we're deferring stat-reporting until all files are sourced,
+ # then add current file to failFile list if any tests in this file
+ # failed
+
+ incr ::tcltest::numTestFiles
+ if {($::tcltest::currentFailure) && \
+ ([lsearch -exact $::tcltest::failFiles $tail] == -1)} {
+ lappend ::tcltest::failFiles $tail
+ }
+ set ::tcltest::currentFailure false
+ }
+}
+
+
+# test --
+#
+# This procedure runs a test and prints an error message if the test fails.
+# If ::tcltest::verbose has been set, it also prints a message even if the
+# test succeeds. The test will be skipped if it doesn't match the
+# ::tcltest::match variable, if it matches an element in
+# ::tcltest::skip, or if one of the elements of "constraints" turns
+# out not to be true.
+#
+# Arguments:
+# name - Name of test, in the form foo-1.2.
+# description - Short textual description of the test, to
+# help humans understand what it does.
+# constraints - A list of one or more keywords, each of
+# which must be the name of an element in
+# the array "::tcltest::testConfig". If any of these
+# elements is zero, the test is skipped.
+# This argument may be omitted.
+# script - Script to run to carry out the test. It must
+# return a result that can be checked for
+# correctness.
+# expectedAnswer - Expected result from script.
+
+proc ::tcltest::test {name description script expectedAnswer args} {
+ incr ::tcltest::numTests(Total)
+
+ # skip the test if it's name matches an element of skip
+
+ foreach pattern $::tcltest::skip {
+ if {[string match $pattern $name]} {
+ incr ::tcltest::numTests(Skipped)
+ return
+ }
+ }
+ # skip the test if it's name doesn't match any element of match
+
+ if {[llength $::tcltest::match] > 0} {
+ set ok 0
+ foreach pattern $::tcltest::match {
+ if {[string match $pattern $name]} {
+ set ok 1
+ break
+ }
+ }
+ if {!$ok} {
+ incr ::tcltest::numTests(Skipped)
+ return
+ }
+ }
+ set i [llength $args]
+ if {$i == 0} {
+ set constraints {}
+ } elseif {$i == 1} {
+
+ # "constraints" argument exists; shuffle arguments down, then
+ # make sure that the constraints are satisfied.
+
+ set constraints $script
+ set script $expectedAnswer
+ set expectedAnswer [lindex $args 0]
+ set doTest 0
+ if {[string match {*[$\[]*} $constraints] != 0} {
+
+ # full expression, e.g. {$foo > [info tclversion]}
+
+ catch {set doTest [uplevel #0 expr $constraints]}
+
+ } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
+
+ # something like {a || b} should be turned into
+ # $::tcltest::testConfig(a) || $::tcltest::testConfig(b).
+
+ regsub -all {[.a-zA-Z0-9]+} $constraints \
+ {$::tcltest::testConfig(&)} c
+ catch {set doTest [eval expr $c]}
+ } else {
+
+ # just simple constraints such as {unixOnly fonts}.
+
+ set doTest 1
+ foreach constraint $constraints {
+ if {![info exists ::tcltest::testConfig($constraint)]
+ || !$::tcltest::testConfig($constraint)} {
+ set doTest 0
+
+ # store the constraint that kept the test from running
+
+ set constraints $constraint
+ break
+ }
+ }
+ }
+ if {$doTest == 0} {
+ incr ::tcltest::numTests(Skipped)
+ if {[string first s $::tcltest::verbose] != -1} {
+ puts stdout "++++ $name SKIPPED: $constraints"
+ }
+
+ # add the constraint to the list of constraints the kept tests
+ # from running
+
+ if {[info exists ::tcltest::skippedBecause($constraints)]} {
+ incr ::tcltest::skippedBecause($constraints)
+ } else {
+ set ::tcltest::skippedBecause($constraints) 1
+ }
+ return
+ }
+ } else {
+ error "wrong # args: must be \"test name description ?constraints? script expectedAnswer\""
+ }
+ memory tag $name
+ set code [catch {uplevel $script} actualAnswer]
+ if {$code != 0 || [string compare $actualAnswer $expectedAnswer] != 0} {
+ incr ::tcltest::numTests(Failed)
+ set ::tcltest::currentFailure true
+ if {[string first b $::tcltest::verbose] == -1} {
+ set script ""
+ }
+ puts stdout "\n==== $name $description FAILED"
+ if {$script != ""} {
+ puts stdout "==== Contents of test case:"
+ puts stdout $script
+ }
+ if {$code != 0} {
+ if {$code == 1} {
+ puts stdout "==== Test generated error:"
+ puts stdout $actualAnswer
+ } elseif {$code == 2} {
+ puts stdout "==== Test generated return exception; result was:"
+ puts stdout $actualAnswer
+ } elseif {$code == 3} {
+ puts stdout "==== Test generated break exception"
+ } elseif {$code == 4} {
+ puts stdout "==== Test generated continue exception"
+ } else {
+ puts stdout "==== Test generated exception $code; message was:"
+ puts stdout $actualAnswer
+ }
+ } else {
+ puts stdout "---- Result was:\n$actualAnswer"
+ }
+ puts stdout "---- Result should have been:\n$expectedAnswer"
+ puts stdout "==== $name FAILED\n"
+ } else {
+ incr ::tcltest::numTests(Passed)
+ if {[string first p $::tcltest::verbose] != -1} {
+ puts stdout "++++ $name PASSED"
+ }
+ }
+}
+
+# ::tcltest::dotests --
+#
+# takes two arguments--the name of the test file (such
+# as "parse.test"), and a pattern selecting the tests you want to
+# execute. It sets ::tcltest::matching to the second argument, calls
+# "source" on the file specified in the first argument, and restores
+# ::tcltest::matching to its pre-call value at the end.
+#
+# Arguments:
+# file name of tests file to source
+# args pattern selecting the tests you want to execute
+#
+# Results:
+# none
+
+proc ::tcltest::dotests {file args} {
+ set savedTests $::tcltest::match
+ set ::tcltest::match $args
+ source $file
+ set ::tcltest::match $savedTests
+}
+
+proc ::tcltest::openfiles {} {
+ if {[catch {testchannel open} result]} {
+ return {}
+ }
+ return $result
+}
+
+proc ::tcltest::leakfiles {old} {
+ if {[catch {testchannel open} new]} {
+ return {}
+ }
+ set leak {}
+ foreach p $new {
+ if {[lsearch $old $p] < 0} {
+ lappend leak $p
+ }
+ }
+ return $leak
+}
+
+set ::tcltest::saveState {}
+
+proc ::tcltest::saveState {} {
+ uplevel #0 {set ::tcltest::saveState [list [info procs] [info vars]]}
+}
+
+proc ::tcltest::restoreState {} {
+ foreach p [info procs] {
+ if {[lsearch [lindex $::tcltest::saveState 0] $p] < 0} {
+ rename $p {}
+ }
+ }
+ foreach p [uplevel #0 {info vars}] {
+ if {[lsearch [lindex $::tcltest::saveState 1] $p] < 0} {
+ uplevel #0 "unset $p"
+ }
+ }
+}
+
+proc ::tcltest::normalizeMsg {msg} {
+ regsub "\n$" [string tolower $msg] "" msg
+ regsub -all "\n\n" $msg "\n" msg
+ regsub -all "\n\}" $msg "\}" msg
+ return $msg
+}
+
+# makeFile --
+#
+# Create a new file with the name <name>, and write <contents> to it.
+#
+# If this file hasn't been created via makeFile since the last time
+# cleanupTests was called, add it to the $filesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeFile {contents name} {
+ set fd [open $name w]
+ fconfigure $fd -translation lf
+ if {[string index $contents [expr {[string length $contents] - 1}]] == "\n"} {
+ puts -nonewline $fd $contents
+ } else {
+ puts $fd $contents
+ }
+ close $fd
+
+ set fullName [file join [pwd] $name]
+ if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+ lappend ::tcltest::filesMade $fullName
+ }
+}
+
+proc ::tcltest::removeFile {name} {
+ file delete $name
+}
+
+# makeDirectory --
+#
+# Create a new dir with the name <name>.
+#
+# If this dir hasn't been created via makeDirectory since the last time
+# cleanupTests was called, add it to the $directoriesMade list, so it will
+# be removed by the next call to cleanupTests.
+#
+proc ::tcltest::makeDirectory {name} {
+ file mkdir $name
+
+ set fullName [file join [pwd] $name]
+ if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} {
+ lappend ::tcltest::filesMade $fullName
+ }
+}
+
+proc ::tcltest::removeDirectory {name} {
+ file delete -force $name
+}
+
+proc ::tcltest::viewFile {name} {
+ global tcl_platform
+ if {($tcl_platform(platform) == "macintosh") || \
+ ($::tcltest::testConfig(unixExecs) == 0)} {
+ set f [open $name]
+ set data [read -nonewline $f]
+ close $f
+ return $data
+ } else {
+ exec cat $name
+ }
+}
+
+#
+# Construct a string that consists of the requested sequence of bytes,
+# as opposed to a string of properly formed UTF-8 characters.
+# This allows the tester to
+# 1. Create denormalized or improperly formed strings to pass to C procedures
+# that are supposed to accept strings with embedded NULL bytes.
+# 2. Confirm that a string result has a certain pattern of bytes, for instance
+# to confirm that "\xe0\0" in a Tcl script is stored internally in
+# UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80".
+#
+# Generally, it's a bad idea to examine the bytes in a Tcl string or to
+# construct improperly formed strings in this manner, because it involves
+# exposing that Tcl uses UTF-8 internally.
+
+proc ::tcltest::bytestring {string} {
+ encoding convertfrom identity $string
+}
+
+# Locate tcltest executable
+
+if {![info exists tk_version]} {
+ set tcltest [info nameofexecutable]
+
+ if {$tcltest == "{}"} {
+ set tcltest {}
+ }
+}
+
+set ::tcltest::testConfig(stdio) 0
+catch {
+ catch {file delete -force tmp}
+ set f [open tmp w]
+ puts $f {
+ exit
+ }
+ close $f
+
+ set f [open "|[list $tcltest tmp]" r]
+ close $f
+
+ set ::tcltest::testConfig(stdio) 1
+}
+catch {file delete -force tmp}
+
+# Deliberately call the socket with the wrong number of arguments. The error
+# message you get will indicate whether sockets are available on this system.
+
+catch {socket} msg
+set ::tcltest::testConfig(socket) \
+ [expr {$msg != "sockets are not available on this system"}]
+
+#
+# Internationalization / ISO support procs -- dl
+#
+
+if {[info commands testlocale]==""} {
+
+ # No testlocale command, no tests...
+ # (it could be that we are a sub interp and we could just load
+ # the Tcltest package but that would interfere with tests
+ # that tests packages/loading in slaves...)
+
+ set ::tcltest::testConfig(hasIsoLocale) 0
+} else {
+ proc ::tcltest::set_iso8859_1_locale {} {
+ set ::tcltest::previousLocale [testlocale ctype]
+ testlocale ctype $::tcltest::isoLocale
+ }
+
+ proc ::tcltest::restore_locale {} {
+ testlocale ctype $::tcltest::previousLocale
+ }
+
+ if {![info exists ::tcltest::isoLocale]} {
+ set ::tcltest::isoLocale fr
+ switch $tcl_platform(platform) {
+ "unix" {
+
+ # Try some 'known' values for some platforms:
+
+ switch -exact -- $tcl_platform(os) {
+ "FreeBSD" {
+ set ::tcltest::isoLocale fr_FR.ISO_8859-1
+ }
+ HP-UX {
+ set ::tcltest::isoLocale fr_FR.iso88591
+ }
+ Linux -
+ IRIX {
+ set ::tcltest::isoLocale fr
+ }
+ default {
+
+ # Works on SunOS 4 and Solaris, and maybe others...
+ # define it to something else on your system
+ #if you want to test those.
+
+ set ::tcltest::isoLocale iso_8859_1
+ }
+ }
+ }
+ "windows" {
+ set ::tcltest::isoLocale French
+ }
+ }
+ }
+
+ set ::tcltest::testConfig(hasIsoLocale) \
+ [string length [::tcltest::set_iso8859_1_locale]]
+ ::tcltest::restore_locale
+}
+
+#
+# procedures that are Tk specific
+#
+
+if {[info exists tk_version]} {
+
+ # If the main window isn't already mapped (e.g. because the tests are
+ # being run automatically) , specify a precise size for it so that the
+ # user won't have to position it manually.
+
+ if {![winfo ismapped .]} {
+ wm geometry . +0+0
+ update
+ }
+
+ # The following code can be used to perform tests involving a second
+ # process running in the background.
+
+ # Locate the tktest executable
+
+ set ::tcltest::tktest [info nameofexecutable]
+ if {$::tcltest::tktest == "{}"} {
+ set ::tcltest::tktest {}
+ puts stdout \
+ "Unable to find tktest executable, skipping multiple process tests."
+ }
+
+ # Create background process
+
+ proc ::tcltest::setupbg args {
+ if {$::tcltest::tktest == ""} {
+ error "you're not running tktest so setupbg should not have been called"
+ }
+ if {[info exists ::tcltest::fd] && ($::tcltest::fd != "")} {
+ cleanupbg
+ }
+
+ # The following code segment cannot be run on Windows prior
+ # to Tk 8.1b3 due to a channel I/O bug (bugID 1495).
+
+ global tcl_platform
+ set ::tcltest::fd [open "|[list $::tcltest::tktest -geometry +0+0 -name tktest] $args" r+]
+ puts $::tcltest::fd "puts foo; flush stdout"
+ flush $::tcltest::fd
+ if {[gets $::tcltest::fd data] < 0} {
+ error "unexpected EOF from \"$::tcltest::tktest\""
+ }
+ if {[string compare $data foo]} {
+ error "unexpected output from background process \"$data\""
+ }
+ fileevent $::tcltest::fd readable bgReady
+ }
+
+ # Send a command to the background process, catching errors and
+ # flushing I/O channels
+
+ proc ::tcltest::dobg {command} {
+ puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
+ flush $::tcltest::fd
+ set ::tcltest::bgDone 0
+ set ::tcltest::bgData {}
+ tkwait variable ::tcltest::bgDone
+ set ::tcltest::bgData
+ }
+
+ # Data arrived from background process. Check for special marker
+ # indicating end of data for this command, and make data available
+ # to dobg procedure.
+
+ proc ::tcltest::bgReady {} {
+ set x [gets $::tcltest::fd]
+ if {[eof $::tcltest::fd]} {
+ fileevent $::tcltest::fd readable {}
+ set ::tcltest::bgDone 1
+ } elseif {$x == "**DONE**"} {
+ set ::tcltest::bgDone 1
+ } else {
+ append ::tcltest::bgData $x
+ }
+ }
+
+ # Exit the background process, and close the pipes
+
+ proc ::tcltest::cleanupbg {} {
+ catch {
+ puts $::tcltest::fd "exit"
+ close $::tcltest::fd
+ }
+ set ::tcltest::fd ""
+ }
+
+ # Clean up focus after using generate event, which
+ # can leave the window manager with the wrong impression
+ # about who thinks they have the focus. (BW)
+
+ proc ::tcltest::fixfocus {} {
+ catch {destroy .focus}
+ toplevel .focus
+ wm geometry .focus +0+0
+ entry .focus.e
+ .focus.e insert 0 "fixfocus"
+ pack .focus.e
+ update
+ focus -force .focus.e
+ destroy .focus
+ }
+}
+
+# threadReap --
+#
+# Kill all threads except for the main thread.
+# Do nothing if testthread is not defined.
+#
+# Arguments:
+# none.
+#
+# Results:
+# Returns the number of existing threads.
+
+if {[info commands testthread] != {}} {
+ proc ::tcltest::threadReap {} {
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != $::tcltest::mainThread} {
+ catch {testthread send -async $tid {testthread exit}}
+ update
+ }
+ }
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+ }
+} else {
+ proc ::tcltest::threadReap {} {
+ return 1
+ }
+}
+
+# Need to catch the import because it fails if defs.tcl is sourced
+# more than once.
+
+catch {namespace import ::tcltest::*}
+return
diff --git a/tk/tests/entry.test b/tk/tests/entry.test
index 0a45f2086e1..db7d8a5b0a6 100644
--- a/tk/tests/entry.test
+++ b/tk/tests/entry.test
@@ -3,23 +3,23 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\""
puts "image, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -51,6 +51,7 @@ 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
@@ -74,25 +75,25 @@ foreach test {
{-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
{-insertontime 100 100 3.2 {expected integer but got "3.2"}}
{-justify right right bogus {bad justification "bogus": must be left, right, or center}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
{-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
{-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
{-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
{-show * * {} {}}
- {-state normal normal bogus {bad state value "bogus": must be normal or disabled}}
+ {-state n normal bogus {bad state "bogus": must be disabled or normal}}
{-takefocus "any string" "any string" {} {}}
{-textvariable i i {} {}}
{-width 402 402 3p {expected integer but got "3p"}}
{-xscrollcommand {Some command} {Some command} {} {}}
} {
set name [lindex $test 0]
- test entry-1.1 {configuration options} {
+ 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.2 {configuration options} {
+ test entry-1.$i {configuration options} {
list [catch {.e configure $name [lindex $test 3]} msg] $msg
} [list 1 [lindex $test 4]]
}
@@ -128,6 +129,7 @@ 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
@@ -145,66 +147,106 @@ test entry-3.5 {EntryWidgetCmd procedure, "bbox" widget command} {
.e delete 0 end
.e bbox 0
} [list 5 5 0 $cy]
-test entry-3.6 {EntryWidgetCmd procedure, "bbox" widget command} {fonts} {
+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 "abcdefghijklmnop"
- list [.e bbox 0] [.e bbox 1] [.e bbox end]
-} [list "5 5 $cx $cy" "[expr 5+$cx] 5 $cx $cy" "[expr 5+15*$cx] 5 $cx $cy"]
-test entry-3.7 {EntryWidgetCmd procedure, "cget" widget command} {
+ .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.8 {EntryWidgetCmd procedure, "cget" widget command} {
+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.9 {EntryWidgetCmd procedure, "cget" widget command} {
+test entry-3.13 {EntryWidgetCmd procedure, "cget" widget command} {
list [catch {.e cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
-test entry-3.10 {EntryWidgetCmd procedure, "cget" widget command} {
+test entry-3.14 {EntryWidgetCmd procedure, "cget" widget command} {
.e configure -bd 4
.e cget -bd
} {4}
-test entry-3.11 {EntryWidgetCmd procedure, "configure" widget command} {
+test entry-3.15 {EntryWidgetCmd procedure, "configure" widget command} {
llength [.e configure]
-} {28}
-test entry-3.12 {EntryWidgetCmd procedure, "configure" widget command} {
+} {33}
+test entry-3.16 {EntryWidgetCmd procedure, "configure" widget command} {
list [catch {.e configure -foo} msg] $msg
} {1 {unknown option "-foo"}}
-test entry-3.13 {EntryWidgetCmd procedure, "configure" widget command} {
+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.14 {EntryWidgetCmd procedure, "delete" widget command} {
+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.15 {EntryWidgetCmd procedure, "delete" widget command} {
+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.16 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.20 {EntryWidgetCmd procedure, "delete" widget command} {
list [catch {.e delete foo} msg] $msg
} {1 {bad entry index "foo"}}
-test entry-3.17 {EntryWidgetCmd procedure, "delete" widget command} {
+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.18 {EntryWidgetCmd procedure, "delete" widget command} {
+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.19 {EntryWidgetCmd procedure, "delete" widget command} {
+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.20 {EntryWidgetCmd procedure, "delete" widget command} {
+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.21 {EntryWidgetCmd procedure, "delete" widget command} {
+test entry-3.26 {EntryWidgetCmd procedure, "delete" widget command} {
.e delete 0 end
.e insert end "01234567890"
.e configure -state disabled
@@ -212,49 +254,55 @@ test entry-3.21 {EntryWidgetCmd procedure, "delete" widget command} {
.e configure -state normal
.e get
} {01234567890}
-test entry-3.22 {EntryWidgetCmd procedure, "get" widget command} {
+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.23 {EntryWidgetCmd procedure, "icursor" widget command} {
+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.24 {EntryWidgetCmd procedure, "icursor" widget command} {
+test entry-3.29 {EntryWidgetCmd procedure, "icursor" widget command} {
list [catch {.e icursor foo} msg] $msg
} {1 {bad entry index "foo"}}
-test entry-3.25 {EntryWidgetCmd procedure, "icursor" widget command} {
+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.26 {EntryWidgetCmd procedure, "index" widget command} {
+test entry-3.31 {EntryWidgetCmd procedure, "index" widget command} {
list [catch {.e in} msg] $msg
-} {1 {bad option "in": must be bbox, cget, configure, delete, get, icursor, index, insert, scan, selection, or xview}}
-test entry-3.27 {EntryWidgetCmd procedure, "index" widget command} {
+} {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.28 {EntryWidgetCmd procedure, "index" widget command} {
+test entry-3.33 {EntryWidgetCmd procedure, "index" widget command} {
list [catch {.e index foo} msg] $msg
} {1 {bad entry index "foo"}}
-test entry-3.29 {EntryWidgetCmd procedure, "index" widget command} {
+test entry-3.34 {EntryWidgetCmd procedure, "index" widget command} {
list [catch {.e index 0} msg] $msg
} {0 0}
-test entry-3.30 {EntryWidgetCmd procedure, "insert" widget command} {
+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.31 {EntryWidgetCmd procedure, "insert" widget command} {
+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.32 {EntryWidgetCmd procedure, "insert" widget command} {
+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.33 {EntryWidgetCmd procedure, "insert" widget command} {
+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.34 {EntryWidgetCmd procedure, "insert" widget command} {
+test entry-3.40 {EntryWidgetCmd procedure, "insert" widget command} {
.e delete 0 end
.e insert end "01234567890"
.e configure -state disabled
@@ -262,24 +310,24 @@ test entry-3.34 {EntryWidgetCmd procedure, "insert" widget command} {
.e configure -state normal
.e get
} {01234567890}
-test entry-3.35 {EntryWidgetCmd procedure, "insert" widget command} {
+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.36 {EntryWidgetCmd procedure, "scan" widget command} {
+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.37 {EntryWidgetCmd procedure, "scan" widget command} {
+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.38 {EntryWidgetCmd procedure, "scan" widget command} {
+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.39 {EntryWidgetCmd procedure, "scan" widget command} {
+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.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
+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 "
@@ -288,16 +336,16 @@ test entry-3.40 {EntryWidgetCmd procedure, "scan" widget command} {fonts} {
.e scan dragto 28
.e index @0
} {2}
-test entry-3.41 {EntryWidgetCmd procedure, "select" widget command} {
+test entry-3.47 {EntryWidgetCmd procedure, "select" widget command} {
list [catch {.e select} msg] $msg
-} {1 {wrong # args: should be ".e select option ?index?"}}
-test entry-3.42 {EntryWidgetCmd procedure, "select" widget command} {
+} {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.43 {EntryWidgetCmd procedure, "select clear" widget command} {
+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.44 {EntryWidgetCmd procedure, "select clear" widget command} {
+test entry-3.50 {EntryWidgetCmd procedure, "select clear" widget command} {
.e delete 0 end
.e insert end "0123456789"
.e select from 1
@@ -306,17 +354,17 @@ test entry-3.44 {EntryWidgetCmd procedure, "select clear" widget command} {
.e select clear
list [catch {selection get} msg] $msg [selection own]
} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} .e}
-test entry-3.45 {EntryWidgetCmd procedure, "selection present" widget command} {
+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.46 {EntryWidgetCmd procedure, "selection present" widget command} {
+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.47 {EntryWidgetCmd procedure, "selection present" widget command} {
+test entry-3.53 {EntryWidgetCmd procedure, "selection present" widget command} {
.e delete 0 end
.e insert end 0123456789
.e select from 3
@@ -325,7 +373,7 @@ test entry-3.47 {EntryWidgetCmd procedure, "selection present" widget command} {
.e selection present
} {1}
.e configure -exportselection true
-test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} {
+test entry-3.54 {EntryWidgetCmd procedure, "selection present" widget command} {
.e delete 0 end
.e insert end 0123456789
.e select from 3
@@ -333,13 +381,13 @@ test entry-3.48 {EntryWidgetCmd procedure, "selection present" widget command} {
.e delete 0 end
.e selection present
} {0}
-test entry-3.49 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+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.50 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+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.51 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+test entry-3.57 {EntryWidgetCmd procedure, "selection adjust" widget command} {
.e delete 0 end
.e insert end "0123456789"
.e select from 1
@@ -348,7 +396,7 @@ test entry-3.51 {EntryWidgetCmd procedure, "selection adjust" widget command} {
.e select adjust 4
selection get
} {123}
-test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} {
+test entry-3.58 {EntryWidgetCmd procedure, "selection adjust" widget command} {
.e delete 0 end
.e insert end "0123456789"
.e select from 1
@@ -357,16 +405,16 @@ test entry-3.52 {EntryWidgetCmd procedure, "selection adjust" widget command} {
.e select adjust 2
selection get
} {234}
-test entry-3.53 {EntryWidgetCmd procedure, "selection from" widget command} {
+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.54 {EntryWidgetCmd procedure, "selection range" widget command} {
+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.55 {EntryWidgetCmd procedure, "selection range" widget command} {
+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.56 {EntryWidgetCmd procedure, "selection range" widget command} {
+test entry-3.62 {EntryWidgetCmd procedure, "selection range" widget command} {
.e delete 0 end
.e insert end 0123456789
.e select from 1
@@ -374,7 +422,7 @@ test entry-3.56 {EntryWidgetCmd procedure, "selection range" widget command} {
.e select range 4 4
list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
-test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} {
+test entry-3.63 {EntryWidgetCmd procedure, "selection range" widget command} {
.e delete 0 end
.e insert end 0123456789
.e select from 3
@@ -385,80 +433,94 @@ test entry-3.57 {EntryWidgetCmd procedure, "selection range" widget command} {
.e delete 0 end
.e insert end "This is quite a long text string, so long that it "
.e insert end "runs off the end of the window quite a bit."
-test entry-3.58 {EntryWidgetCmd procedure, "selection to" widget command} {
+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.59 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
.e xview 5
.e xview
} {0.0537634 0.268817}
-test entry-3.60 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.66 {EntryWidgetCmd procedure, "xview" widget command} {
list [catch {.e xview gorp} msg] $msg
} {1 {bad entry index "gorp"}}
-test entry-3.61 {EntryWidgetCmd procedure, "xview" widget command} {
+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.62 {EntryWidgetCmd procedure, "xview" widget command} {
+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.63 {EntryWidgetCmd procedure, "xview" widget command} {
+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.64 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.70 {EntryWidgetCmd procedure, "xview" widget command} {
.e xview moveto 0.5
.e xview
} {0.505376 0.72043}
-test entry-3.65 {EntryWidgetCmd procedure, "xview" widget command} {
+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.66 {EntryWidgetCmd procedure, "xview" widget command} {
+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.67 {EntryWidgetCmd procedure, "xview" widget command} {
+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.68 {EntryWidgetCmd procedure, "xview" widget command} {
+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.69 {EntryWidgetCmd procedure, "xview" widget command} {
+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.70 {EntryWidgetCmd procedure, "xview" widget command} {
+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.71 {EntryWidgetCmd procedure, "xview" widget command} {
+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.72 {EntryWidgetCmd procedure, "xview" widget command} {
+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.73 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.79 {EntryWidgetCmd procedure, "xview" widget command} {
.e xview 0
update
.e xview -4
.e index @0
} {0}
-test entry-3.74 {EntryWidgetCmd procedure, "xview" widget command} {
+test entry-3.80 {EntryWidgetCmd procedure, "xview" widget command} {
.e xview 300
.e index @0
} {73}
-test entry-3.75 {EntryWidgetCmd procedure} {
+.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, or xview}}
+} {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
@@ -662,7 +724,7 @@ test entry-6.9 {EntryComputeGeometry procedure} {fonts} {
update
list [winfo reqwidth .e] [winfo reqheight .e]
} {25 39}
-test entry-6.10 {EntryComputeGeometry procedure} {fonts} {
+test entry-6.10 {EntryComputeGeometry procedure} {unixOnly fonts} {
catch {destroy .e}
entry .e -bd 1 -relief raised -width 0 -show .
.e insert 0 12345
@@ -674,6 +736,21 @@ test entry-6.10 {EntryComputeGeometry procedure} {fonts} {
.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
@@ -1089,52 +1166,62 @@ test entry-13.9 {GetEntryIndex procedure} {
list [.e index sel.first] [.e index sel.last]
} {1 6}
selection clear .e
-test entry-13.10 {GetEntryIndex procedure} {pc} {
- .e index sel.first
-} {1}
-test entry-13.11 {GetEntryIndex procedure} {!pc} {
+test entry-13.10 {GetEntryIndex procedure} {unixOnly} {
+ # On unix, when selection is cleared, entry widget's internal
+ # selection range is reset.
+
list [catch {.e index sel.first} msg] $msg
} {1 {selection isn't in entry}}
-test entry-13.12 {GetEntryIndex procedure} {pc} {
- list [catch {.e index sbogus} msg] $msg
-} {1 {bad entry index "sbogus"}}
-test entry-13.13 {GetEntryIndex procedure} {!pc} {
+test entry-13.11 {GetEntryIndex procedure} {macOrPc} {
+ # On mac and pc, when selection is cleared, entry widget remembers
+ # last selected range. When selection ownership is restored to
+ # entry, the old range will be rehighlighted.
+
+ list [catch {selection get}] [.e index sel.first]
+} {1 1}
+test entry-13.12 {GetEntryIndex procedure} {unixOnly} {
list [catch {.e index sbogus} msg] $msg
} {1 {selection isn't in entry}}
-test entry-13.14 {GetEntryIndex procedure} {
+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.15 {GetEntryIndex procedure} {fonts} {
+test entry-13.16 {GetEntryIndex procedure} {fonts} {
.e index @4
} {4}
-test entry-13.16 {GetEntryIndex procedure} {fonts} {
+test entry-13.17 {GetEntryIndex procedure} {fonts} {
.e index @11
} {4}
-test entry-13.17 {GetEntryIndex procedure} {fonts} {
+test entry-13.18 {GetEntryIndex procedure} {fonts} {
.e index @12
} {5}
-test entry-13.18 {GetEntryIndex procedure} {fonts} {
+test entry-13.19 {GetEntryIndex procedure} {fonts} {
.e index @[expr [winfo width .e] - 6]
} {8}
-test entry-13.19 {GetEntryIndex procedure} {fonts} {
+test entry-13.20 {GetEntryIndex procedure} {fonts} {
.e index @[expr [winfo width .e] - 5]
} {9}
-test entry-13.20 {GetEntryIndex procedure} {
+test entry-13.21 {GetEntryIndex procedure} {
.e index @1000
} {9}
-test entry-13.21 {GetEntryIndex procedure} {
+test entry-13.22 {GetEntryIndex procedure} {
list [catch {.e index 1xyz} msg] $msg
} {1 {bad entry index "1xyz"}}
-test entry-13.22 {GetEntryIndex procedure} {
+test entry-13.23 {GetEntryIndex procedure} {
.e index -10
} {0}
-test entry-13.23 {GetEntryIndex procedure} {
+test entry-13.24 {GetEntryIndex procedure} {
.e index 12
} {12}
-test entry-13.24 {GetEntryIndex procedure} {
+test entry-13.25 {GetEntryIndex procedure} {
.e index 49
} {21}
-test entry-13.25 {GetEntryIndex procedure} {fonts} {
+test entry-13.26 {GetEntryIndex procedure} {fonts} {
catch {destroy .e}
entry .e -show .
.e insert 0 XXXYZZY
@@ -1199,14 +1286,20 @@ test entry-16.1 {EntryVisibleRange procedure} {fonts} {
.e insert 0 .............................
.e xview
} {0 0.827586}
-test entry-16.2 {EntryVisibleRange procedure} {fonts} {
+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-16.3 {EntryVisibleRange procedure} {
+test entry-15.4 {EntryVisibleRange procedure} {
.e delete 0 end
.e xview
} {0 1}
@@ -1236,34 +1329,194 @@ test entry-17.3 {EntryUpdateScrollbar procedure} {
set scrollInfo
} {0.315789 0.842105}
test entry-17.4 {EntryUpdateScrollbar procedure} {
- catch {destroy .e}
+ destroy .e
proc bgerror msg {
global x
set x $msg
}
- entry .e -width 5 -xscrollcommand bogus
+ entry .e -width 5 -xscrollcommand thisisnotacommand
pack .e
update
rename bgerror {}
list $x $errorInfo
-} {{invalid command name "bogus"} {invalid command name "bogus"
+} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand"
while executing
-"bogus 0 1"
+"thisisnotacommand 0 1"
(horizontal scrolling command executed by entry)}}
set l [interp hidden]
eval destroy [winfo children .]
test entry-18.1 {Entry widget vs hiding} {
- catch {destroy .e}
+ 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
+}
+.e configure -validate all
+
+test entry-19.18 {entry 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 entry textvar is also set
+test entry-19.19 {entry 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 entry widget shown as is in the textvar.
+test entry-19.20 {entry widget validation} {
+ 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
+##
+
# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
# and EntryTextVarProc.
-
option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/event.test b/tk/tests/event.test
index 5cbfffe817f..b6ca6fe44ba 100644
--- a/tk/tests/event.test
+++ b/tk/tests/event.test
@@ -3,14 +3,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -31,6 +30,7 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
bind .b <Destroy> {
lappend x destroy
event generate .b <1>
+ event generate .b <ButtonRelease-1>
}
bind .b <1> {
lappend x button
@@ -39,3 +39,32 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
destroy .b
set x
} {destroy}
+
+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
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/filebox.test b/tk/tests/filebox.test
index 98ae0d36af9..c9112bf405a 100644
--- a/tk/tests/filebox.test
+++ b/tk/tests/filebox.test
@@ -3,15 +3,24 @@
# for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
#
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
set tk_strictMotif_old $tk_strictMotif
+# Some tests require user interaction on non-unix platform
+
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+ [expr {$::tcltest::testConfig(userInteraction) || \
+ $::tcltest::testConfig(unixOnly)}]
+
#----------------------------------------------------------------------
#
# Procedures needed by this test file
@@ -45,7 +54,7 @@ proc EnterFileByKey {parent fileName fileDir} {
} else {
set w $parent.__tk_filedialog
}
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::__tk_filedialog data
if {$tk_strictMotif} {
$data(sEnt) delete 0 end
@@ -66,7 +75,7 @@ proc SendButtonPress {parent btn type} {
} else {
set w $parent.__tk_filedialog
}
- upvar #0 [winfo name $w] data
+ upvar ::tk::dialog::file::__tk_filedialog data
set button $data($btn\Btn)
if ![winfo ismapped $button] {
@@ -90,16 +99,19 @@ proc SendButtonPress {parent btn type} {
#
#----------------------------------------------------------------------
-if {[string compare test [info procs test]] == 1} {
- source defs
-}
-
if {$tcl_platform(platform) == "unix"} {
set modes "0 1"
} else {
set modes 1
}
+set unknownOptionsMsg {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+
+set tmpFile "filebox.tmp"
+makeFile {
+ # this file can be empty!
+} $tmpFile
+
foreach mode $modes {
#
@@ -116,17 +128,11 @@ foreach mode $modes {
#
foreach command "tk_getOpenFile tk_getSaveFile" {
-
- if {$command == "tk_getOpenFile" && $mode == 0} {
- set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent or -title}}
- } else {
- set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}}
- }
-
test filebox-1.1 "$command command" {
list [catch {$command -foo} msg] $msg
} $unknownOptionsMsg
+ catch {$command -foo 1} msg
regsub -all , $msg "" options
regsub \"-foo\" $options "" options
@@ -154,16 +160,12 @@ foreach mode $modes {
list [catch {$command -filetypes {Foo}} msg] $msg
} {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
- if {[info commands tkMotifFDialog] == "" && [info commands tkFDialog] == ""} {
+ if {[info commands tkMotifFDialog] == "" && [info commands ::tk::dialog::file::tkFDialog] == ""} {
set isNative 1
} else {
set isNative 0
}
- if {$isNative && ![info exists INTERACTIVE]} {
- continue
- }
-
set parent .
set verylongstring longstring:
@@ -178,54 +180,51 @@ foreach mode $modes {
# set verylongstring $verylongstring$verylongstring
set color #404040
- test filebox-2.1 "$command command" {
+ test filebox-2.1 "$command command" {nonUnixUserInteraction} {
ToPressButton $parent cancel
$command -title "Press Cancel ($verylongstring)" -parent $parent
} ""
-
if {$command == "tk_getSaveFile"} {
set fileName "12x 455"
set fileDir [pwd]
set pathName [file join [pwd] $fileName]
} else {
- set thisFile [info script]
- set fileName [file tail $thisFile]
- set appPWD [pwd]
- cd [file dirname $thisFile]
+ set fileName $tmpFile
set fileDir [pwd]
- cd $appPWD
set pathName [file join $fileDir $fileName]
}
- test filebox-2.2 "$command command" {
+ test filebox-2.2 "$command command" {nonUnixUserInteraction} {
ToPressButton $parent ok
set choice [$command -title "Press Ok" \
-parent $parent -initialfile $fileName -initialdir $fileDir]
} $pathName
- test filebox-2.3 "$command command" {
+ test filebox-2.3 "$command command" {nonUnixUserInteraction} {
ToEnterFileByKey $parent $fileName $fileDir
set choice [$command -title "Enter \"$fileName\" and press Ok" \
-parent $parent -initialdir $fileDir]
} $pathName
- test filebox-2.4 "$command command" {
+ test filebox-2.4 "$command command" {nonUnixUserInteraction} {
ToPressButton $parent ok
set choice [$command -title "Enter \"$fileName\" and press Ok" \
-parent $parent -initialdir . \
-initialfile $fileName]
} $pathName
- test filebox-2.5 "$command command" {
+ test filebox-2.5 "$command command" {nonUnixUserInteraction} {
ToPressButton $parent ok
set choice [$command -title "Enter \"$fileName\" and press Ok" \
-parent $parent -initialdir /badpath \
-initialfile $fileName]
} $pathName
- test filebox-2.6 "$command command" {
+ test filebox-2.6 "$command command" {nonUnixUserInteraction} {
toplevel .t1; toplevel .t2
+ wm geometry .t1 +0+0
+ wm geometry .t2 +0+0
ToPressButton .t1 ok
set choice {}
lappend choice [$command \
@@ -269,21 +268,17 @@ foreach mode $modes {
}
foreach x [lsort -integer [array names filters]] {
- test filebox-3.$x "$command command" {
+ test filebox-3.$x "$command command" {nonUnixUserInteraction} {
ToPressButton $parent ok
set choice [$command -title "Press Ok" -filetypes $filters($x)\
-parent $parent -initialfile $fileName -initialdir $fileDir]
} $pathName
}
- #
- # 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
+ # The rest of the tests need to be executed on Unix only.
+ # The test whether the dialog box widgets were implemented correctly.
+ # These tests are not
# needed on the other platforms because they use native file dialogs.
- #
-
-
-
# end inner if
}
@@ -293,10 +288,7 @@ foreach mode $modes {
set tk_strictMotif $tk_strictMotif_old
-if {$isNative && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
- return
-}
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/focus.test b/tk/tests/focus.test
index b10ee5e89e2..05c3c839781 100644
--- a/tk/tests/focus.test
+++ b/tk/tests/focus.test
@@ -3,18 +3,13 @@
# standard fashion for Tcl tests.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "unix"} {
- return
-}
-
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
eval destroy [winfo children .]
@@ -38,7 +33,6 @@ proc focusSetupAlt {} {
global env
catch {destroy .alt}
toplevel .alt -screen $env(TK_ALT_DISPLAY)
- wm withdraw .alt
foreach i {a b c d} {
button .alt.$i -text .alt.$i -relief raised -bd 2
pack .alt.$i
@@ -47,7 +41,7 @@ proc focusSetupAlt {} {
}
# Make sure the window manager knows who has focus
-fixfocus
+catch {fixfocus}
# The following procedure ensures that there is no input focus
# in this application. It does it by arranging for another
@@ -65,8 +59,8 @@ proc focusClear {} {
}
focusSetup
-set altDisplay [info exists env(TK_ALT_DISPLAY)]
-if $altDisplay {
+set ::tcltest::testConfig(altDisplay) [info exists env(TK_ALT_DISPLAY)]
+if {$::tcltest::testConfig(altDisplay)} {
focusSetupAlt
}
update
@@ -81,37 +75,35 @@ bind all <KeyPress> {
append focusInfo "press %W %K"
}
-test focus-1.1 {Tk_FocusCmd procedure} {
+test focus-1.1 {Tk_FocusCmd procedure} {unixOnly} {
focusClear
focus
} {}
-if $altDisplay {
- test focus-1.2 {Tk_FocusCmd procedure} {
- focus .alt.b
- focus
- } {}
-}
-test focus-1.3 {Tk_FocusCmd procedure} {
+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} {
+test focus-1.4 {Tk_FocusCmd procedure} {unixOnly} {
list [catch {focus ""} msg] $msg
} {0 {}}
-test focus-1.5 {Tk_FocusCmd procedure} {
+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} {
+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} {
+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} {
+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
@@ -130,90 +122,88 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} {
destroy .t2
set x
} {.t2.f2 .t2 .t2}
-test focus-1.9 {Tk_FocusCmd procedure, -displayof option} {
+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} {
+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} {
+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} {
+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} {
+test focus-1.13 {Tk_FocusCmd procedure, -displayof option} {unixOnly} {
focusClear
focus -force .t
focus -displayof .t.b3
} {.t}
-if $altDisplay {
- test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {
- focus -force .alt.c
- focus -displayof .alt
- } {.alt.c}
-}
-test focus-1.15 {Tk_FocusCmd procedure, -force option} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+test focus-1.25 {Tk_FocusCmd procedure} {unixOnly} {
list [catch {focus -unknown} msg] $msg
} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}}
-if {[string compare testwrapper [info commands testwrapper]] != 0} {
- puts "This application hasn't been compiled with the testwrapper command,"
- puts "therefore I am skipping all of these tests."
- return
-}
+# Some tests require the testwrapper command
+
+set ::tcltest::testConfig(testwrapper) \
+ [expr {[info commands testwrapper] != {}}]
-test focus-2.1 {TkFocusFilterEvent procedure} {nonPortable} {
+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
+ event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \
+ -sendevent 0x54217567
list $focusInfo
} {{}}
-test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} {
+test focus-2.2 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
focus -force .b
destroy .t
focusSetup
@@ -223,7 +213,7 @@ test focus-2.2 {TkFocusFilterEvent procedure} {nonPortable} {
list $focusInfo [focus]
} {{in .t NotifyAncestor
} .b}
-test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} {
+test focus-2.3 {TkFocusFilterEvent procedure} {unixOnly nonPortable testwrapper} {
focus -force .b
destroy .t
focusSetup
@@ -236,7 +226,8 @@ test focus-2.3 {TkFocusFilterEvent procedure} {nonPortable} {
out . NotifyNonlinearVirtual
in .t NotifyNonlinear
} .t}
-test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} {nonPortable} {
+test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \
+ {unixOnly nonPortable testwrapper} {
set result {}
focus .t.b1
# Important to end with NotifyAncestor, which is an
@@ -266,7 +257,8 @@ in .t.b1 NotifyNonlinear
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
}}
-test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPortable} {
+test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \
+ {unixOnly nonPortable testwrapper} {
focusSetup
focus .t.b1
update
@@ -276,7 +268,8 @@ test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} {nonPor
in .t NotifyNonlinearVirtual
in .t.b1 NotifyNonlinear
} .t.b1}
-test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} {
+test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \
+ {unixOnly testwrapper} {
focus .t.b1
focus .
update
@@ -286,7 +279,8 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} {
event gen . <KeyPress-x>
list $x $focusInfo
} {.t.b1 {press .t.b1 x}}
-test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} {
+test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \
+ {unixOnly testwrapper} {
set result {}
foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot
@@ -298,17 +292,20 @@ test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} {
}
set result
} {{} .t.b1 {} {} .t.b1 .t.b1 {}}
-test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} {
+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} {
+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} {
+test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
set result {}
focus .t.b1
focusClear
@@ -322,14 +319,16 @@ test focus-2.10 {TkFocusFilterEvent procedure, Enter events} {
}
set result
} {.t.b1 {} .t.b1 .t.b1 .t.b1}
-test focus-2.11 {TkFocusFilterEvent procedure, Enter events} {
+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} {
+test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
focus -force .b
update
set focusInfo {}
@@ -337,7 +336,8 @@ test focus-2.12 {TkFocusFilterEvent procedure, Enter events} {
update
set focusInfo
} {}
-test focus-2.13 {TkFocusFilterEvent procedure, Enter events} {
+test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \
+ {unixOnly testwrapper} {
focus .t.b1
focusClear
event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
@@ -347,7 +347,7 @@ test focus-2.13 {TkFocusFilterEvent procedure, Enter events} {
} {in .t NotifyVirtual
in .t.b1 NotifyAncestor
}
-test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {
+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
@@ -358,7 +358,8 @@ test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when
update
destroy .t2
} {}
-test focus-2.15 {TkFocusFilterEvent procedure, Leave events} {
+test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \
+ {unixOnly testwrapper} {
set result {}
focus .t.b1
foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear
@@ -372,7 +373,8 @@ test focus-2.15 {TkFocusFilterEvent procedure, Leave events} {
}
set result
} {{} .t.b1 {} {} {}}
-test focus-2.16 {TkFocusFilterEvent procedure, Leave events} {
+test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \
+ {unixOnly testwrapper} {
set result {}
focus .t.b1
event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
@@ -384,7 +386,8 @@ test focus-2.16 {TkFocusFilterEvent procedure, Leave events} {
} {out .t.b1 NotifyAncestor
out .t NotifyVirtual
}
-test focus-2.17 {TkFocusFilterEvent procedure, Leave events} {
+test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \
+ {unixOnly testwrapper} {
set result {}
focus .t.b1
event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1
@@ -398,7 +401,8 @@ test focus-2.17 {TkFocusFilterEvent procedure, Leave events} {
out .t NotifyVirtual
} {}}
-test focus-3.1 {SetFocus procedure, create record on focus} {
+test focus-3.1 {SetFocus procedure, create record on focus} \
+ {unixOnly testwrapper} {
toplevel .t2 -width 250 -height 100
wm geometry .t2 +0+0
update
@@ -410,7 +414,8 @@ 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} {
+test focus-3.2 {SetFocus procedure, making window exist} \
+ {unixOnly testwrapper} {
update
button .b2 -text "Another button"
focus .b2
@@ -420,12 +425,14 @@ 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} {
+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} {
+test focus-3.4 {SetFocus procedure, delaying claim of X focus} \
+ {unixOnly testwrapper} {
focusSetup
wm withdraw .t
focus -force .t.b2
@@ -438,7 +445,8 @@ test focus-3.4 {SetFocus procedure, delaying claim of X focus} {
wm deiconify .t
} {}
catch {destroy .t2}
-test focus-3.5 {SetFocus procedure, generating events} {
+test focus-3.5 {SetFocus procedure, generating events} \
+ {unixOnly testwrapper} {
focusSetup
focusClear
set focusInfo {}
@@ -448,7 +456,8 @@ test focus-3.5 {SetFocus procedure, generating events} {
} {in .t NotifyVirtual
in .t.b2 NotifyAncestor
}
-test focus-3.6 {SetFocus procedure, generating events} {
+test focus-3.6 {SetFocus procedure, generating events} \
+ {unixOnly testwrapper} {
focusSetup
focus -force .b
update
@@ -461,7 +470,8 @@ out . NotifyNonlinearVirtual
in .t NotifyNonlinearVirtual
in .t.b2 NotifyNonlinear
}
-test focus-3.7 {SetFocus procedure, generating events} {nonPortable} {
+test focus-3.7 {SetFocus procedure, generating events} \
+ {unixOnly nonPortable testwrapper} {
# Non-portable because some platforms generate extra events.
focusSetup
@@ -472,7 +482,7 @@ test focus-3.7 {SetFocus procedure, generating events} {nonPortable} {
set focusInfo
} {}
-test focus-4.1 {TkFocusDeadWindow procedure} {
+test focus-4.1 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
focusSetup
update
focus -force .b
@@ -480,7 +490,7 @@ test focus-4.1 {TkFocusDeadWindow procedure} {
destroy .t
focus
} {.b}
-test focus-4.2 {TkFocusDeadWindow procedure} {
+test focus-4.2 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
focusSetup
update
focus -force .t.b2
@@ -494,7 +504,7 @@ test focus-4.2 {TkFocusDeadWindow procedure} {
# Non-portable due to wm-specific redirection of input focus when
# windows are deleted:
-test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} {
+test focus-4.3 {TkFocusDeadWindow procedure} {unixOnly nonPortable testwrapper} {
focusSetup
update
focus .t
@@ -503,7 +513,7 @@ test focus-4.3 {TkFocusDeadWindow procedure} {nonPortable} {
update
focus
} {}
-test focus-4.4 {TkFocusDeadWindow procedure} {
+test focus-4.4 {TkFocusDeadWindow procedure} {unixOnly testwrapper} {
focusSetup
focus -force .t.b2
update
@@ -514,7 +524,21 @@ test focus-4.4 {TkFocusDeadWindow procedure} {
# I don't know how to test most of the remaining procedures of this file
# explicitly; they've already been exercised by the preceding tests.
-test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} {
+# If send is disabled because of inadequate security, don't run any
+# of these tests at all.
+
+setupbg
+set app [dobg {tk appname}]
+set ::tcltest::testConfig(secureServer) 1
+if {[catch {send $app set a 0} msg] == 1} {
+ if [string match "X server insecure *" $msg] {
+ set ::tcltest::testConfig(secureServer) 0
+ }
+}
+cleanupbg
+setupbg
+test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \
+ {unixOnly testwrapper secureServer} {
focusSetup
focus -force .t
update
@@ -524,7 +548,7 @@ test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} {
focus .t.b2
update
lappend result [focus]
-} {.t .t {}}
+} {.t {} {}}
catch {destroy .t}
bind all <FocusIn> {}
@@ -533,7 +557,8 @@ bind all <KeyPress> {}
cleanupbg
fixfocus
-test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly} {
+test focus-6.1 {miscellaneous - embedded application in same process} \
+ {unixOnly testwrapper} {
eval interp delete [interp slaves]
catch {destroy .t}
toplevel .t
@@ -582,7 +607,8 @@ test focus-6.1 {miscellaneous - embedded application in same process} {unixOnly}
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} {
+test focus-6.2 {miscellaneous - embedded application in different process} \
+ {unixOnly testwrapper} {
eval interp delete [interp slaves]
catch {destroy .t}
setupbg
@@ -634,3 +660,21 @@ test focus-6.2 {miscellaneous - embedded application in different process} {unix
eval destroy [winfo children .]
bind all <FocusIn> {}
bind all <FocusOut> {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/focusTcl.test b/tk/tests/focusTcl.test
index 19dc0a09c47..bacf1a27f48 100644
--- a/tk/tests/focusTcl.test
+++ b/tk/tests/focusTcl.test
@@ -4,14 +4,13 @@
# standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
eval destroy [winfo children .]
@@ -277,3 +276,20 @@ test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} {
bind Frame <Key> {}
. configure -takefocus 0 -highlightthickness 0
option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/font.test b/tk/tests/font.test
index f36fe049544..1df9e7dfb97 100644
--- a/tk/tests/font.test
+++ b/tk/tests/font.test
@@ -1,16 +1,21 @@
# This file is a Tcl script to test out Tk's "font" command
# plus the procedures in tkFont.c. It is organized in the
-# standard fashion for Tcl tests.
+# standard white-box fashion for Tcl tests.
#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1996-1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] != 0} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info commands testfont] != "testfont"} {
+ puts "testfont command not available; skipping tests"
+ ::tcltest::cleanupTests
+ return
}
catch {destroy .b}
@@ -20,7 +25,7 @@ update idletasks
proc setup {} {
catch {destroy .b.f}
- catch {font delete xyz}
+ catch {eval font delete [font names]}
label .b.f
pack .b.f
update
@@ -56,243 +61,357 @@ case $tcl_platform(platform) {
}
set times [font actual {times 0} -family]
-test font-1.1 {font command: general} {
+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-1.2 {font command: actual: arguments} {
+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-1.3 {font command: actual: arguments} {
+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-1.4 {font command: actual: arguments} {
+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-1.5 {font command: actual: arguments} {
- list [catch {font actual {}} msg] $msg
-} {1 {font "" doesn't exist}}
-test font-1.6 {font command: actual: displayof specified, so skip to next} {
+test font-4.4 {font command: actual: displayof specified, so skip to next} {
catch {font actual xyz -displayof . -size}
} {0}
-test font-1.7 {font command: actual: displayof specified, so skip to next} {
+test font-4.5 {font command: actual: displayof specified, so skip to next} {
lindex [font actual xyz -displayof .] 0
} {-family}
-test font-1.8 {font command: actual} {unix || mac} {
+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-1.9 {font command: actual} {pcOnly} {
+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-1.10 {font command: actual} {
- lindex [font actual {-family times}] 0
-} {-family}
-test font-1.11 {font command: bad option} {
+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-2.1 {font command: configure} {
+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-2.2 {font command: configure: non-existent font} {
+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-2.3 {font command: configure: "deleted" font} {
+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-2.4 {font command: configure: get all options} {
+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-2.5 {font command: configure: get one option} {
+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-2.6 {font command: configure: update existing font} {
+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-2.7 {font command: configure: bad option} {
+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-3.1 {font command: create: make up name} {
- font delete [font create]
- font delete [font create -family xyz]
-} {}
-test font-3.2 {font command: create: already exists} {
+test font-6.1 {font command: create: make up name} {
+ # (objc < 3) so name = NULL
setup
- font create xyz
- list [catch {font create xyz} msg] $msg
-} {1 {font "xyz" already exists}}
-test font-3.3 {font command: create: error recreating "deleted" font} {
+ font create
+ font names
+} {font1}
+test font-6.2 {font command: create: name specified} {
+ # not (objc < 3)
setup
font create xyz
- .b.f configure -font xyz
- font delete xyz
- list [catch {font create xyz -xyz times} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-3.4 {font command: create: recreate "deleted" font} {
+ font names
+} {xyz}
+test font-6.3 {font command: create: name not really specified} {
+ # (name[0] == '-') so name = NULL
setup
- font create xyz
- .b.f configure -font xyz
- font delete xyz
- font actual xyz
- font create xyz -family times
- update
- font configure xyz -family
-} {times}
-test font-3.5 {font command: create: bad option creating new font} {
+ 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-3.6 {font command: create: totally new font} {
+test font-6.6 {font command: create: bad option creating new font} {
+ # name was not specified so skip = 2
setup
- font create xyz -family xyz
- font configure xyz -family
-} {xyz}
+ 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-4.1 {font command: delete: arguments} {
+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-4.2 {font command: delete: loop test} {
+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 delete a b c
- list [font actual a -underline] [font actual b -underline] [font actual c -underline]
-} {0 0 0}
-test font-4.3 {font command: delete: non-existent} {
+ 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-4.4 {font command: delete: mark for later deletion} {
+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
-} {1 {named font "xyz" doesn't exist}}
-test font-4.5 {font command: delete: actually delete} {
+ 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
- font actual xyz -underline
-} {0}
+ catch {font config xyz}
+} {1}
+setup
-test font-5.1 {font command: families: arguments} {
+test font-8.1 {font command: families: arguments} {
+ # (skip < 0)
list [catch {font families -displayof} msg] $msg
} {1 {value for "-displayof" missing}}
-test font-5.2 {font command: families: arguments} {
+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-5.3 {font command: families} {
- font families
- set x {}
-} {}
+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-6.1 {font command: measure: arguments} {
+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-6.2 {font command: measure: arguments} {
+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-6.3 {font command: measure: arguments} {
+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-6.4 {font command: measure: arguments} {
- list [catch {font measure {} abc} msg] $msg
-} {1 {font "" doesn't exist}}
-test font-6.5 {font command: measure} {
+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-7.1 {font command: metrics: arguments} {
+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-7.2 {font command: metrics: arguments} {
+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-7.3 {font command: metrics: get all metrics} {
+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-7.4 {font command: metrics: get ascent} {
- catch {expr [font metrics $fixed -ascent]}
-} {0}
-test font-7.5 {font command: metrics: get descent} {
- catch {expr [font metrics {-family xyz} -descent]}
-} {0}
-test font-7.6 {font command: metrics: get linespace} {
- catch {expr [font metrics {-family fixed} -linespace]}
-} {0}
-test font-7.7 {font command: metrics: get fixed} {
- catch {expr [font metrics {-family fixed} -fixed]}
-} {0}
-test font-7.8 {font command: metrics: get ascent} {
- catch {expr [font metrics {-family xyz} -ascent]}
-} {0}
-test font-7.9 {font command: metrics: get descent} {
- catch {expr [font metrics {-family xyz} -descent]}
-} {0}
-test font-7.10 {font command: metrics: get linespace} {
- catch {expr [font metrics {-family fixed} -linespace]}
-} {0}
-test font-7.11 {font command: metrics: get fixed} {
- catch {expr [font metrics {-family fixed} -fixed]}
-} {0}
-test font-7.12 {font command: metrics: bad metric} {
- list [catch {font metrics {-family fixed} -xyz} msg] $msg
+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-8.1 {font command: names: arguments} {
+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-8.2 {font command: 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
- set x [lsort [font names]]
- font delete abc
- font delete xyz
- set x
-} {abc xyz}
-test font-8.3 {font command: names} {
+ 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
- set x [lsort [font names]]
+ lappend x [lsort [font names]]
.b.f config -font xyz
font delete xyz
lappend x [font names]
- font delete abc
- set x
-} {abc xyz abc}
+} {{abc xyz} abc}
-test font-9.1 {font command: unknown option} {
- list [catch {font xyz} msg] $msg
-} {1 {bad option "xyz": must be actual, configure, create, delete, families, measure, metrics, or names}}
-
-test font-10.1 {UpdateDependantFonts procedure: no users} {
+test font-12.1 {UpdateDependantFonts procedure: no users} {
+ # (nfPtr->refCount == 0)
setup
font create xyz
font configure xyz -family times
} {}
-test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
+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
@@ -306,56 +425,155 @@ test font-10.2 {UpdateDependantFonts procedure: pings the widgets} {
expr {$a1==$b1 && $a2==$b2}
} {1}
-test font-11.1 {Tk_GetFont procedure: bump ref count} {
+test font-13.1 {CreateNamedFont: new named font} {
+ # not (new == 0)
+ setup
+ set x {}
+ lappend x [font names]
+ font create xyz
+ lappend x [font names]
+} {{} xyz}
+test font-13.2 {CreateNamedFont: named font already exists} {
+ # (new == 0)
+ setup
+ font create xyz
+ list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+test font-13.3 {CreateNamedFont: named font already exists} {
+ # (nfPtr->deletePending == 0)
+ setup
+ font create xyz
+ list [catch {font create xyz} msg] $msg
+} {1 {named font "xyz" already exists}}
+test font-13.4 {CreateNamedFont: recreate "deleted" font} {
+ # not (nfPtr->deletePending == 0)
+ setup
+ font create xyz -family times
+ .b.f configure -font xyz
+ font delete xyz
+ font create xyz -family courier
+ font configure xyz -family
+} {courier}
+
+test font-14.1 {Tk_GetFont procedure} {
+} {}
+
+test font-15.1 {Tk_AllocFontFromObj - converting internal reps} {
+ set x {Times 16}
+ lindex $x 0
+ destroy .b1 .b2
+ button .b1 -font $x
+ lindex $x 0
+ testfont counts {Times 16}
+} {{1 0}}
+test font-15.2 {Tk_AllocFontFromObj - discard stale font} {
+ set x {Times 16}
+ destroy .b1 .b2
+ button .b1 -font $x
+ destroy .b1
+ set result {}
+ lappend result [testfont counts {Times 16}]
+ button .b2 -font $x
+ lappend result [testfont counts {Times 16}]
+} {{} {{1 1}}}
+test font-15.3 {Tk_AllocFontFromObj - reuse existing font} {
+ set x {Times 16}
+ destroy .b1 .b2
+ button .b1 -font $x
+ set result {}
+ lappend result [testfont counts {Times 16}]
+ button .b2 -font $x
+ pack .b1 .b2 -side top
+ lappend result [testfont counts {Times 16}]
+} {{{1 1}} {{2 1}}}
+test font-15.4 {Tk_AllocFontFromObj procedure: bump ref count} {
+ # (new == 0)
setup
.b.f config -font {-family fixed}
lindex [font actual {-family fixed}] 0
} {-family}
-test font-11.2 {Tk_GetFont procedure: bump ref count of named font, too} {
+test font-15.5 {Tk_AllocFontFromObj procedure: get named font} {
+ # (namedHashPtr != NULL)
setup
- font create xyz
- .b.f config -font xyz
- lindex [font actual xyz] 0
-} {-family}
-test font-11.3 {Tk_GetFont procedure: get named font} {
+ font create xyz
+ .b.f config -font xyz
+} {}
+test font-15.6 {Tk_AllocFontFromObj procedure: not a named font} {
+ # not (namedHashPtr != NULL)
setup
- font create xyz
- .b.f config -font xyz
+ .b.f config -font {times 20}
} {}
-test font-11.4 {Tk_GetFont procedure: get native font} {unixOnly} {
+test font-15.7 {Tk_AllocFontFromObj procedure: get native font} {unixOnly} {
+ # not (fontPtr == NULL)
setup
.b.f config -font fixed
} {}
-test font-11.5 {Tk_GetFont procedure: get native font} {pcOnly} {
+test font-15.8 {Tk_AllocFontFromObj procedure: get native font} {pcOnly} {
+ # not (fontPtr == NULL)
setup
.b.f config -font oemfixed
} {}
-test font-11.6 {Tk_GetFont procedure: get native font} {macOnly} {
+test font-15.9 {Tk_AllocFontFromObj procedure: get native font} {macOnly} {
+ # not (fontPtr == NULL)
setup
.b.f config -font application
} {}
-test font-11.7 {Tk_GetFont procedure: get attribute font} {
+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-11.8 {Tk_GetFont procedure: get attribute font} {
+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-11.9 {Tk_GetFont procedure: no match} {
- list [catch {font actual {}} msg] $msg
-} {1 {font "" doesn't exist}}
+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-12.1 {Tk_NameOfFont procedure} {
+test font-16.1 {Tk_NameOfFont procedure} {
setup
- .b.f config -font {-family fixed}
+ .b.f config -font -family\ fixed
.b.f cget -font
} {-family fixed}
-test font-13.1 {Tk_FreeFont procedure: one ref} {
+test font-17.1 {Tk_FreeFontFromObj - reference counts} {
+ set x {Courier 12}
+ destroy .b1 .b2 .b3
+ button .b1 -font $x
+ button .b3 -font $x
+ button .b2 -font $x
+ set result {}
+ lappend result [testfont counts {Courier 12}]
+ destroy .b1
+ lappend result [testfont counts {Courier 12}]
+ destroy .b2
+ lappend result [testfont counts {Courier 12}]
+ destroy .b3
+ lappend result [testfont counts {Courier 12}]
+} {{{3 1}} {{2 1}} {{1 1}} {}}
+test font-17.2 {Tk_FreeFont procedure: one ref} {
+ # (fontPtr->refCount == 0)
setup
.b.f config -font {-family fixed}
destroy .b.f
} {}
-test font-13.2 {Tk_FreeFont procedure: multiple ref} {
+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}
@@ -364,14 +582,16 @@ test font-13.2 {Tk_FreeFont procedure: multiple ref} {
destroy .b.b
set x
} {-family fixed}
-test font-13.3 {Tk_FreeFont procedure: named font} {
+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-13.4 {Tk_FreeFont procedure: named font} {
+test font-17.5 {Tk_FreeFont procedure: named font} {
+ # not (fontPtr->refCount == 0)
setup
font create xyz -underline 1
.b.f config -font xyz
@@ -380,9 +600,9 @@ test font-13.4 {Tk_FreeFont procedure: named font} {
destroy .b.f
list [font actual xyz -underline] $x
} {0 1}
-test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
+test font-17.6 {Tk_FreeFont procedure: named font not deleted yet} {
setup
- font create xyz
+ font create xyz
.b.f config -font xyz
button .b.b -font xyz
font delete xyz
@@ -391,12 +611,32 @@ test font-13.5 {Tk_FreeFont procedure: named font not deleted yet} {
list [lindex [font actual xyz] 0] [lindex $x 0]
} {-family -family}
-test font-14.1 {Tk_FontId} {
+test font-18.1 {FreeFontObjProc} {
+ destroy .b1
+ set x [format {Courier 12}]
+ button .b1 -font $x
+ set y [format {Courier 12}]
+ .b1 configure -font $y
+ set z [format {Courier 12}]
+ .b1 configure -font $z
+ set result {}
+ lappend result [testfont counts {Courier 12}]
+ set x red
+ lappend result [testfont counts {Courier 12}]
+ set z 32
+ lappend result [testfont counts {Courier 12}]
+ destroy .b1
+ lappend result [testfont counts {Courier 12}]
+ set y bogus
+ set result
+} {{{1 3}} {{1 2}} {{1 1}} {}}
+
+test font-19.1 {Tk_FontId} {
.b.f config -font "times 20"
update
} {}
-test font-15.1 {Tk_FontMetrics procedure} {
+test font-20.1 {Tk_GetFontMetrics procedure} {
button .b.w1 -text abc
entry .b.w2 -text abcd
update
@@ -405,7 +645,7 @@ test font-15.1 {Tk_FontMetrics procedure} {
proc psfontname {name} {
set a [.b.c itemcget text -font]
- .b.c itemconfig text -font $name
+ .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]
@@ -414,7 +654,7 @@ proc psfontname {name} {
set start [string first "gsave" $post]
return [string range $post [expr $start+7] end]
}
-test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
+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"
@@ -422,25 +662,25 @@ test font-16.1 {Tk_PostscriptFontName procedure: native} {unixOnly} {
set x {AvantGarde-Book}
}
} {AvantGarde-Book}
-test font-16.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.2 {Tk_PostscriptFontName procedure: native} {pcOnly} {
psfontname "arial 10"
} {Helvetica}
-test font-16.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.3 {Tk_PostscriptFontName procedure: native} {pcOnly} {
psfontname "{times new roman} 10"
} {Times-Roman}
-test font-16.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
+test font-21.4 {Tk_PostscriptFontName procedure: native} {pcOnly} {
psfontname "{courier new} 10"
} {Courier}
-test font-16.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.5 {Tk_PostscriptFontName procedure: native} {macOnly} {
psfontname "geneva 10"
} {Helvetica}
-test font-16.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.6 {Tk_PostscriptFontName procedure: native} {macOnly} {
psfontname "{new york} 10"
} {Times-Roman}
-test font-16.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
+test font-21.7 {Tk_PostscriptFontName procedure: native} {macOnly} {
psfontname "monaco 10"
} {Courier}
-test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+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"
@@ -448,7 +688,7 @@ test font-16.8 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
set x {LucidaBright}
}
} {LucidaBright}
-test font-16.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
+test font-21.9 {Tk_PostscriptFontName procedure: spaces} {unixOnly} {
psfontname "{new century schoolbook} 10"
} {NewCenturySchlbk-Roman}
set i 10
@@ -464,7 +704,7 @@ foreach p {
{"zapfchancery" ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic ZapfChancery-MediumItalic}
{"zapfdingbats" ZapfDingbats ZapfDingbats ZapfDingbats ZapfDingbats}
} {
- test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
+ test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {unixOnly} {
set family [lindex $p 0]
set x {}
set i 1
@@ -490,7 +730,7 @@ foreach p {
{"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
{"times new roman" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
- test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
+ test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {pcOnly} {
set family [lindex $p 0]
set x {}
foreach slant {roman italic} {
@@ -511,7 +751,7 @@ foreach p {
{"symbol" Symbol Symbol-Bold Symbol-Italic Symbol-BoldItalic}
{"times" Times-Roman Times-Bold Times-Italic Times-BoldItalic}
} {
- test font-16.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
+ test font-21.$i {Tk_PostscriptFontName procedure: exhaustive} {macOnly} {
set family [lindex $p 0]
set x {}
foreach slant {roman italic} {
@@ -524,7 +764,11 @@ foreach p {
} [lrange $p 1 end]
}
-test font-17.1 {Tk_UnderlineChars procedure} {
+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
@@ -533,39 +777,39 @@ test font-17.1 {Tk_UnderlineChars procedure} {
} {}
setup
-test font-18.1 {Tk_ComputeTextLayout: empty string} {
+test font-24.1 {Tk_ComputeTextLayout: empty string} {
.b.l config -text ""
} {}
-test font-18.2 {Tk_ComputeTextLayout: simple string} {
+test font-24.2 {Tk_ComputeTextLayout: simple string} {
.b.l config -text "000"
getsize
} "[expr $ax*3] $ay"
-test font-18.3 {Tk_ComputeTextLayout: find special chars} {
+test font-24.3 {Tk_ComputeTextLayout: find special chars} {
.b.l config -text "000\n000"
getsize
} "[expr $ax*3] [expr $ay*2]"
-test font-18.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
+test font-24.4 {Tk_ComputeTextLayout: calls Tk_MeasureChars} {
.b.l config -text "000\n000"
getsize
} "[expr $ax*3] [expr $ay*2]"
-test font-18.5 {Tk_ComputeTextLayout: break line} {
+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-18.6 {Tk_ComputeTextLayout: normal ended on special char} {
+test font-24.6 {Tk_ComputeTextLayout: normal ended on special char} {
.b.l config -text "000\n000"
} {}
-test font-18.7 {Tk_ComputeTextLayout: special char was \n} {
+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-18.8 {Tk_ComputeTextLayout: special char was \t} {
+test font-24.8 {Tk_ComputeTextLayout: special char was \t} {
.b.l config -text "000\t00"
getsize
} "[expr $ax*10] $ay"
-test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
+test font-24.9 {Tk_ComputeTextLayout: tab didn't cause break} {
set x {}
.b.l config -text "000\t000"
lappend x [getsize]
@@ -574,7 +818,7 @@ test font-18.9 {Tk_ComputeTextLayout: tab didn't cause break} {
.b.l config -wrap 0
set x
} "{[expr $ax*11] $ay} {[expr $ax*11] $ay}"
-test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
+test font-24.10 {Tk_ComputeTextLayout: tab caused break} {
set x {}
.b.l config -text "000\t"
lappend x [getsize]
@@ -583,7 +827,7 @@ test font-18.10 {Tk_ComputeTextLayout: tab caused break} {
.b.l config -wrap 0
set x
} "{[expr $ax*3] $ay} {[expr $ax*3] [expr $ay*2]}"
-test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
+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]
@@ -592,7 +836,7 @@ test font-18.11 {Tk_ComputeTextLayout: absorb spaces at eol} {
.b.l config -wrap 0
set x
} "{[expr $ax*3] [expr $ay*2]} {[expr $ax*3] $ay}"
-test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
+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]
@@ -601,14 +845,14 @@ test font-18.12 {Tk_ComputeTextLayout: append non-printing spaces to chunk} {
.b.l config -wrap 0
set x
} "{[expr $ax*4] [expr $ay*2]} {[expr $ax*10] [expr $ay*2]}"
-test font-18.13 {Tk_ComputeTextLayout: many lines -> realloc line array} {
+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-18.14 {Tk_ComputeTextLayout: text ended with \n} {
+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-18.15 {Tk_ComputeTextLayout: justification} {
+test font-24.15 {Tk_ComputeTextLayout: justification} {
csetup "000\n00000"
set x {}
.b.c itemconfig text -just left
@@ -621,52 +865,52 @@ test font-18.15 {Tk_ComputeTextLayout: justification} {
set x
} {2 1 0}
-test font-19.1 {Tk_FreeTextLayout procedure} {
+test font-25.1 {Tk_FreeTextLayout procedure} {
setup
.b.f config -text foo
.b.f config -text boo
} {}
-test font-20.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
+test font-26.1 {Tk_DrawTextLayout procedure: auto-detect last char} {
.b.f config -text foo
} {}
-test font-20.2 {Tk_DrawTextLayout procedure: multiple chunks} {
+test font-26.2 {Tk_DrawTextLayout procedure: multiple chunks} {
csetup "000\t00\n000"
} {}
-test font-20.3 {Tk_DrawTextLayout: draw subset of chunk: numDisplay <= 0} {
+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-20.4 {Tk_DrawTextLayout: draw subset of chunk: firstChar <= 0} {
+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-20.5 {Tk_DrawTextLayout: draw subset of chunk: firstChar > 0} {
+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-20.6 {Tk_DrawTextLayout: draw subset of chunk: lastChar < numChars} {
+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-21.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
+test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} {
.b.f config -text "foo" -under -1
} {}
-test font-21.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
+test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} {
.b.f config -text "000 00000" -wrap [expr $ax*7] -under 10
} {}
-test font-21.3 {Tk_UnderlineTextLayout procedure: underline is visible} {
+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-22.1 {Tk_PointToChar procedure: above all lines} {
+test font-28.1 {Tk_PointToChar procedure: above all lines} {
csetup "000"
.b.c index text @-1,0
} {0}
-test font-22.2 {Tk_PointToChar procedure: no chars} {
+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
@@ -678,103 +922,103 @@ test font-22.2 {Tk_PointToChar procedure: no chars} {
csetup ""
.b.c index text @100,100
} {0}
-test font-22.3 {Tk_PointToChar procedure: loop test} {
+test font-28.3 {Tk_PointToChar procedure: loop test} {
csetup "000\n000\n000\n000"
.b.c index text @10000,0
} {3}
-test font-22.4 {Tk_PointToChar procedure: intersect line} {
+test font-28.4 {Tk_PointToChar procedure: intersect line} {
csetup "000\n000\n000"
.b.c index text @0,$ay
} {4}
-test font-22.5 {Tk_PointToChar procedure: to the left of all chunks} {
+test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} {
.b.c index text @-100,$ay
} {4}
-test font-22.6 {Tk_PointToChar procedure: past any possible chunk} {
+test font-28.6 {Tk_PointToChar procedure: past any possible chunk} {
.b.c index text @100000,$ay
} {7}
-test font-22.7 {Tk_PointToChar procedure: which chunk on this line} {
+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-22.8 {Tk_PointToChar procedure: which chunk on this line} {
+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-22.9 {Tk_PointToChar procedure: in special chunk} {
+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-22.10 {Tk_PointToChar procedure: past all chars in chunk} {
+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-22.11 {Tk_PointToChar procedure: below all chunks} {
+test font-28.11 {Tk_PointToChar procedure: below all chunks} {
csetup "000 0000000"
.b.c index text @0,1000000
} {11}
-test font-23.1 {Tk_CharBBox procedure: index < 0} {
+test font-29.1 {Tk_CharBBox procedure: index < 0} {
.b.f config -text "000" -underline -1
} {}
-test font-23.2 {Tk_CharBBox procedure: loop} {
+test font-29.2 {Tk_CharBBox procedure: loop} {
.b.f config -text "000\t000\t000\t000" -underline 9
} {}
-test font-23.3 {Tk_CharBBox procedure: special char} {
+test font-29.3 {Tk_CharBBox procedure: special char} {
.b.f config -text "000\t000\t000" -underline 7
} {}
-test font-23.4 {Tk_CharBBox procedure: normal char} {
+test font-29.4 {Tk_CharBBox procedure: normal char} {
.b.f config -text "000" -underline 1
} {}
-test font-23.5 {Tk_CharBBox procedure: right edge of bbox truncated} {
+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-23.6 {Tk_CharBBox procedure: bbox pegged to right edge} {
+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-24.1 {Tk_TextLayoutToPoint procedure: loop once} {
+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-24.2 {Tk_TextLayoutToPoint procedure: loop multiple} {
+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-24.3 {Tk_TextLayoutToPoint procedure: loop to end} {
+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-24.4 {Tk_TextLayoutToPoint procedure: hit a special char (tab)} {
+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-24.5 {Tk_TextLayoutToPoint procedure: ignore newline} {
+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-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
+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 {}
@@ -784,42 +1028,42 @@ test font-24.6 {Tk_TextLayoutToPoint procedure: ignore spaces at eol} {
set x
} {}
.b.c itemconfig text -justify center
-test font-24.7 {Tk_TextLayoutToPoint procedure: on left side} {
+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-24.8 {Tk_TextLayoutToPoint procedure: on right side} {
+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-24.9 {Tk_TextLayoutToPoint procedure: inside line} {
+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-24.10 {Tk_TextLayoutToPoint procedure: above line} {
+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-24.11 {Tk_TextLayoutToPoint procedure: below line} {
+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-24.12 {Tk_TextLayoutToPoint procedure: in line} {
+test font-30.12 {Tk_DistanceToTextLayout procedure: in line} {
csetup "0\n000"
set x {}
event generate .b.c <Leave>
@@ -827,7 +1071,7 @@ test font-24.12 {Tk_TextLayoutToPoint procedure: in line} {
set x
} {3}
.b.c itemconfig text -justify left
-test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
+test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} {
csetup "000"
set x {}
event generate .b.c <Leave>
@@ -835,27 +1079,27 @@ test font-24.13 {Tk_TextLayoutToPoint procedure: exact hit} {
set x
} {1}
-test font-25.1 {Tk_TextLayoutToArea procedure: loop once} {
+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-25.2 {Tk_TextLayoutToArea procedure: loop multiple} {
+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-25.3 {Tk_TextLayoutToArea procedure: loop to end} {
+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-25.4 {Tk_TextLayoutToArea procedure: hit a special char (tab)} {
+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-25.5 {Tk_TextLayoutToArea procedure: ignore newlines} {
+test font-31.5 {Tk_IntersectTextLayout procedure: ignore newlines} {
csetup "000\n0\n000"
.b.c find overlapping $ax $ay $ax $ay
} {}
-test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} {
+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]
@@ -863,7 +1107,7 @@ test font-25.6 {Tk_TextLayoutToArea procedure: ignore spaces at eol} {
set x
} {}
-test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
+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.
@@ -910,29 +1154,19 @@ test font-26.1 {Tk_TextLayoutToPostscript: ensure buffer doesn't overflow} {
(end)
}
-test font-27.1 {Tk_TextWidth procedure} {
- font measure [.b.l cget -font] "000"
-} [expr $ax*3]
-
-test font-28.1 {SetupFontMetrics procedure} {
- setup
- .b.f config -font $fixed
+test font-33.1 {Tk_TextWidth procedure} {
} {}
-test font-29.1 {TkInitFontAttributes procedure} {
+test font-33.2 {ConfigAttributesObj procedure: arguments} {
+ # (Tcl_GetIndexFromObj() != TCL_OK)
setup
- font create xyz
- font config xyz
-} {-family {} -size 0 -weight normal -slant roman -underline 0 -overstrike 0}
-
-test font-30.1 {ConfigAttributes procedure: arguments} {
+ 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 {missing value for "-family" option}}
-test font-30.2 {ConfigAttributes procedure: arguments} {
- setup
- list [catch {font create xyz -xyz xyz} msg] $msg
-} {1 {bad option "-xyz": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
+} {1 {value for "-family" option missing}}
set i 3
foreach p {
{family xyz times}
@@ -943,7 +1177,7 @@ foreach p {
{overstrike 0 1}
} {
set opt [lindex $p 0]
- test font-30.$i "ConfigAttributes procedure: $opt" {
+ test font-34.$i "ConfigAttributesObj procedure: $opt" {
setup
set x {}
font create xyz -$opt [lindex $p 1]
@@ -955,27 +1189,37 @@ foreach p {
}
foreach p {
{size xyz {1 {expected integer but got "xyz"}}}
- {weight xyz {1 {bad -weight value "xyz": must be normal, bold}}}
- {slant xyz {1 {bad -slant value "xyz": must be roman, italic}}}
+ {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-30.$i "ConfigAttributes procedure: [lindex $p 0]" {
+ 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-31.1 {GetAttributeInfo procedure: error} {
- list [catch {font actual xyz -style} msg] $msg
-} {1 {bad option "-style": must be -family, -size, -weight, -slant, -underline, or -overstrike}}
-test font-31.2 {GetAttributeInfo procedure: all attributes} {
+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 3
+set i 4
foreach p {
{family xyz xyz}
{size 20 20}
@@ -993,100 +1237,148 @@ foreach p {
}
# In tests below, one field is set to "xyz" so that font name doesn't
-# look like a native X font, so that ParseFontName or TkParseXLFD will
+# look like a native X font, so that ParseFontNameObj or TkParseXLFD will
# be called.
setup
-test font-32.1 {ParseFontName procedure: begins with -} {
+test font-38.1 {ParseFontNameObj procedure: begins with -} {
lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
-test font-32.2 {ParseFontName procedure: begins with -*} {
+test font-38.2 {ParseFontNameObj procedure: begins with -*} {
lindex [font actual -*-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
-test font-32.3 {ParseFontName procedure: begins with -, doesn't look like list} {
+test font-38.3 {ParseFontNameObj procedure: begins with -, doesn't look like list} {
lindex [font actual -xyz-times-*-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
-test font-32.4 {ParseFontName procedure: begins with -, looks like list} {
+test font-38.4 {ParseFontNameObj procedure: begins with -, looks like list} {
lindex [font actual {-family times}] 1
} $times
-test font-32.5 {ParseFontName procedure: begins with *} {
+test font-38.5 {ParseFontNameObj procedure: begins with *} {
lindex [font actual *-times-xyz-*-*-*-*-*-*-*-*-*-*-*] 1
} $times
-test font-32.6 {ParseFontName procedure: begins with *} {
+test font-38.6 {ParseFontNameObj procedure: begins with *} {
font actual *-times-xyz -family
} $times
-test font-32.7 {ParseFontName procedure: arguments} {
- list [catch {font actual {}} msg] $msg
+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-32.8 {ParseFontName procedure: arguments} {
+test font-38.9 {ParseFontNameObj procedure: arguments} {
list [catch {font actual {times 20 xyz xyz}} msg] $msg
} {1 {unknown font style "xyz"}}
-test font-32.9 {ParseFontName procedure: arguments} {
+test font-38.10 {ParseFontNameObj procedure: arguments} {
list [catch {font actual {times xyz xyz}} msg] $msg
} {1 {expected integer but got "xyz"}}
-test font-32.10 {ParseFontName procedure: stylelist loop} {macOnly} {
+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-32.11 {ParseFontName procedure: stylelist loop} {unixOrPc} {
+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-32.12 {ParseFontName procedure: stylelist error} {
+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-33.1 {TkParseXLFD procedure: initial dash} {
+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-33.2 {TkParseXLFD procedure: no initial dash} {
+test font-40.2 {TkFontParseXLFD procedure: no initial dash} {
font actual *-times-*-*-*-*-*-*-*-*-*-*-*-xyz -family
} $times
-test font-33.3 {TkParseXLFD procedure: not enough fields} {
+test font-40.3 {TkFontParseXLFD procedure: not enough fields} {
font actual -xyz-times-*-*-* -family
} $times
-test font-33.4 {TkParseXLFD procedure: all fields unspecified} {
+test font-40.4 {TkFontParseXLFD procedure: all fields unspecified} {
lindex [font actual -xyz-*-*-*-*-*-*-*-*-*-*-*-*-*] 0
} {-family}
-test font-33.5 {TkParseXLFD procedure: all fields specified} {
+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-33.6 {TkParseXLFD procedure: arguments} {
+test font-41.1 {TkParseXLFD procedure: arguments} {
# XLFD with bad pointsize: fallback to some system font.
font actual -*-*-*-*-*-*-xyz-*-*-*-*-*-*-*
set x {}
} {}
-test font-33.7 {TkParseXLFD procedure: arguments} {
+test font-42.1 {TkFontParseXLFD procedure: arguments} {
# XLFD with bad pixelsize: fallback to some system font.
font actual -*-*-*-*-*-*-*-xyz-*-*-*-*-*-*
set x {}
} {}
-test font-33.8 {TkParseXLFD procedure: pixelsize specified} {
+test font-42.2 {TkFontParseXLFD procedure: pixelsize specified} {
font metrics -xyz-times-*-*-*-*-12-*-*-*-*-*-*-* -linespace
set x {}
} {}
-test font-33.9 {TkParseXLFD procedure: weird pixelsize specified} {
+test font-42.3 {TkFontParseXLFD procedure: weird pixelsize specified} {
font metrics {-xyz-times-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*-*} -linespace
set x {}
} {}
-test font-33.10 {TkParseXLFD procedure: pointsize specified} {
+test font-42.4 {TkFontParseXLFD procedure: pointsize specified} {
font metrics -xyz-times-*-*-*-*-*-120-*-*-*-*-*-* -linespace
set x {}
} {}
-test font-33.11 {TkParseXLFD procedure: weird pointsize specified} {
+test font-42.5 {TkFontParseXLFD procedure: weird pointsize specified} {
font metrics {-xyz-times-*-*-*-*-*-[ 12.0 0 12.0 0]-*-*-*-*-*-*} -linespace
set x {}
} {}
-test font-34.1 {FieldSpecified procedure: specified vs. non-specified} {
+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
-test font-35.1 {NewChunk procedure: test realloc} {
- .b.f config -text "xxx\nxxx\txxx\nxxx\t\t\t"
-} {}
+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/tk/tests/frame.test b/tk/tests/frame.test
index 3919f576a97..24ccb984d46 100644
--- a/tk/tests/frame.test
+++ b/tk/tests/frame.test
@@ -4,14 +4,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -538,18 +537,21 @@ test frame-8.2 {FrameCmdDeletedProc procedure} {
update
list [info command .f*] [winfo children .]
} {{} {}}
-test frame-8.3 {FrameCmdDeletedProc procedure} {
- eval destroy [winfo children .]
- toplevel .f1 -menu .m
- wm geometry .f1 +0+0
- menu .m
- update
- rename .f1 {}
- update
- set result [list [info command .f*] [winfo children .]]
- eval destroy [winfo children .]
- set result
-} {{} .m}
+#
+# 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}
@@ -615,3 +617,20 @@ test frame-11.2 {TkInstallFrameMenu - frame renamed} {
catch {destroy .f}
rename eatColors {}
rename colorsFree {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/geometry.test b/tk/tests/geometry.test
index 1144e3ef95c..5a0c495229b 100644
--- a/tk/tests/geometry.test
+++ b/tk/tests/geometry.test
@@ -4,14 +4,13 @@
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -247,5 +246,22 @@ test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
update
winfo ismapped .t.quit
} {1}
+
catch {destroy .t}
-concat
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/get.test b/tk/tests/get.test
new file mode 100644
index 00000000000..0bfa5b9af9c
--- /dev/null
+++ b/tk/tests/get.test
@@ -0,0 +1,97 @@
+# This file is a Tcl script to test out the procedures in the file
+# tkGet.c. It is organized in the standard fashion for Tcl
+# white-box tests.
+#
+# Copyright (c) 1998 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+button .b
+test get-1.1 {Tk_GetAnchorFromObj} {
+ .b configure -anchor n
+ .b cget -anchor
+} {n}
+test get-1.2 {Tk_GetAnchorFromObj} {
+ .b configure -anchor ne
+ .b cget -anchor
+} {ne}
+test get-1.3 {Tk_GetAnchorFromObj} {
+ .b configure -anchor e
+ .b cget -anchor
+} {e}
+test get-1.4 {Tk_GetAnchorFromObj} {
+ .b configure -anchor se
+ .b cget -anchor
+} {se}
+test get-1.5 {Tk_GetAnchorFromObj} {
+ .b configure -anchor s
+ .b cget -anchor
+} {s}
+test get-1.6 {Tk_GetAnchorFromObj} {
+ .b configure -anchor sw
+ .b cget -anchor
+} {sw}
+test get-1.7 {Tk_GetAnchorFromObj} {
+ .b configure -anchor w
+ .b cget -anchor
+} {w}
+test get-1.8 {Tk_GetAnchorFromObj} {
+ .b configure -anchor nw
+ .b cget -anchor
+} {nw}
+test get-1.9 {Tk_GetAnchorFromObj} {
+ .b configure -anchor n
+ .b cget -anchor
+} {n}
+test get-1.10 {Tk_GetAnchorFromObj} {
+ .b configure -anchor center
+ .b cget -anchor
+} {center}
+test get-1.11 {Tk_GetAnchorFromObj - error} {
+ list [catch {.b configure -anchor unknown} msg] $msg
+} {1 {bad anchor "unknown": must be n, ne, e, se, s, sw, w, nw, or center}}
+
+catch {destroy .b}
+button .b
+test get-2.1 {Tk_GetJustifyFromObj} {
+ .b configure -justify left
+ .b cget -justify
+} {left}
+test get-2.2 {Tk_GetJustifyFromObj} {
+ .b configure -justify right
+ .b cget -justify
+} {right}
+test get-2.3 {Tk_GetJustifyFromObj} {
+ .b configure -justify center
+ .b cget -justify
+} {center}
+test get-2.4 {Tk_GetJustifyFromObj - error} {
+ list [catch {.b configure -justify stupid} msg] $msg
+} {1 {bad justification "stupid": must be left, right, or center}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/grid.test b/tk/tests/grid.test
index f4e27626efc..e9720cb9480 100644
--- a/tk/tests/grid.test
+++ b/tk/tests/grid.test
@@ -2,28 +2,14 @@
# of Tk. It is (almost) organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source ../tests/defs}
-
-# Test Arguments:
-# name - Name of test, in the form foo-1.2.
-# description - Short textual description of the test, to
-# help humans understand what it does.
-# constraints - A list of one or more keywords, each of
-# which must be the name of an element in
-# the array "testConfig". If any of these
-# elements is zero, the test is skipped.
-# This argument may be omitted.
-# script - Script to run to carry out the test. It must
-# return a result that can be checked for
-# correctness.
-# answer - Expected result from script.
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# helper routine to return "." to a sane state after a test
# The variable GRID_VERBOSE can be used to "look" at the result
@@ -310,18 +296,18 @@ test grid-6.7 {location (y)} {
grid_reset 6.7
test grid-6.8 {location (weights)} {
- frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ 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 110 -height 15
+ .a configure -width 200 -height 15
update
set got ""
set result ""
- for {set y -10} { $y < 120} { incr y} {
+ for {set y -10} { $y < 210} { incr y} {
set a [grid location . $y $y]
if {$a != $got} {
lappend result $y->$a
@@ -329,10 +315,10 @@ test grid-6.8 {location (weights)} {
}
}
set result
-} {{-10->-1 -1} {0->0 0} {16->0 1} {111->1 1}}
+} {{-10->-1 -1} {0->0 0} {16->0 1} {201->1 1}}
grid_reset 6.8
-test grid-6.9 {location: check updates pending} {
+test grid-6.9 {location: check updates pending} {nonPortable} {
set a ""
foreach i {0 1 2} {
frame .$i -width 120 -height 75 -bg red
@@ -384,7 +370,16 @@ test grid-7.6 {propagate} {
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
@@ -798,6 +793,22 @@ test grid-11.14 {default widget placement} {
} {{0,25 50,50} {50,0 50,50} {50,50 50,50}}
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-12.1 {-sticky} {
catch {unset data}
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1002,23 +1013,26 @@ test grid-14.2 {structure notify} {
} {{0 0 200 100,0 0 200 100} {0 0 240 140,20 20 200 100}}
grid_reset 14.2
-test grid-14.3 {map notify} {
- global A
- catch {unset A}
- bind . <Configure> {incr A(%W)}
- set A(.) 0
- foreach i {0 1 2} {
- frame .$i -width 100 -height 75
- set A(.$i) 0
- }
- grid .0 .1 .2
- update
- bind <Configure> .1 {destroy .0}
- .2 configure -bd 10
- update
- bind . <Configure> {}
- array get A
-} {.2 2 .0 1 . 1 .1 1}
+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} {
@@ -1203,3 +1217,44 @@ test grid-16.8 {layout internal constraints} {
}
set a
} {0 30 70 250 280 , 0 30 130 230 260 , 0 30 113 197 280 , 0 30 60 90 120 }
+
+test grid-17.1 {forget and pending idle handlers} {
+ # This test is intended to detect a crash caused by a failure to remove
+ # pending idle handlers when grid forget is invoked.
+
+ toplevel .t
+ 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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/id.test b/tk/tests/id.test
index c6ee46f9714..91d75c6112a 100644
--- a/tk/tests/id.test
+++ b/tk/tests/id.test
@@ -3,19 +3,19 @@
# the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
if {[string compare testwrapper [info commands testwrapper]] != 0} {
puts "This application hasn't been compiled with the testwrapper command,"
puts "therefore I am skipping all of these tests."
+ ::tcltest::cleanupTests
return
}
@@ -100,3 +100,20 @@ test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly} {
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/tk/tests/image.test b/tk/tests/image.test
index fc899c0939a..ea0f0be00d5 100644
--- a/tk/tests/image.test
+++ b/tk/tests/image.test
@@ -4,23 +4,23 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -355,3 +355,20 @@ test image-13.1 {image command vs hidden commands} {
destroy .c
eval image delete [image names]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/imgBmap.test b/tk/tests/imgBmap.test
index ec8d7d1fa11..2ce431f302f 100644
--- a/tk/tests/imgBmap.test
+++ b/tk/tests/imgBmap.test
@@ -4,14 +4,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -472,3 +471,20 @@ removeFile foo.bm
removeFile foo2.bm
destroy .c
eval image delete [image names]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/imgPPM.test b/tk/tests/imgPPM.test
index e0ffb0a3393..39e2a66485f 100644
--- a/tk/tests/imgPPM.test
+++ b/tk/tests/imgPPM.test
@@ -3,14 +3,13 @@
# The files is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -75,7 +74,7 @@ test imgPPM-2.1 {FileWritePPM procedure} {
} {1 {couldn't open "not_a_dir/bar/baz/gorp": no such file or directory} {posix enoent {no such file or directory}}}
test imgPPM-2.2 {FileWritePPM procedure} {
catch {unset data}
- p1 write test2.ppm
+ p1 write -format ppm test2.ppm
set fd [open test2.ppm]
set data [read $fd]
close $fd
@@ -154,3 +153,20 @@ test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} {
removeFile test.ppm
removeFile test2.ppm
eval image delete [image names]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/imgPhoto.test b/tk/tests/imgPhoto.test
index e0c6f568ea1..a221a3e65e0 100644
--- a/tk/tests/imgPhoto.test
+++ b/tk/tests/imgPhoto.test
@@ -4,16 +4,15 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# Author: Paul Mackerras (paulus@cs.anu.edu.au)
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -28,6 +27,30 @@ canvas .c
pack .c
update
+# temporarily copy the README fiel from testsDir to tmpDir
+if {![file exists README]} {
+ set newREADME [file join $::tcltest::workingDir README]
+ file copy [file join $::tcltest::testsDir README] $newREADME
+ set removeREADME 1
+}
+
+# find the teapot.ppm file for use in these tests
+# first look in $tk_library/demos/images/teapot.ppm
+# then look in <this file>/../../library/demos/images/teapot.ppm
+# skip this file if you can't find the teapot.ppm file.
+set teapotPhotoFile [file join $tk_library demos images teapot.ppm]
+if {![file exists $teapotPhotoFile]} {
+ set newLib [file dirname $::tcltest::testsDir]
+ set teapotPhotoFile \
+ [file join $newLib library demos images teapot.ppm]
+ if {![file exists $teapotPhotoFile]} {
+ puts "Can't find [file join demos images teapot.ppm] in $tk_library"
+ puts "your Tk library is incomplete, so I am skipping imgPhoto tests."
+ ::tcltest::cleanupTests
+ return 0
+ }
+}
+
test imgPhoto-1.1 {options for photo images} {
image create photo p1 -width 79 -height 83
list [lindex [p1 configure -width] 4] [lindex [p1 configure -height] 4] \
@@ -38,21 +61,19 @@ test imgPhoto-1.2 {options for photo images} {
[string tolower $err]
} {1 {couldn't open "no.such.file": no such file or directory}}
test imgPhoto-1.3 {options for photo images} {
- list [catch {image create photo p1 -file \
- [file join $tk_library demos/images/teapot.ppm] \
+ list [catch {image create photo p1 -file $teapotPhotoFile \
-format no.such.format} err] $err
} {1 {image file format "no.such.format" is not supported}}
test imgPhoto-1.4 {options for photo images} {
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p1 -file $teapotPhotoFile
list [image width p1] [image height p1]
} {256 256}
test imgPhoto-1.5 {options for photo images} {
- image create photo p1 \
- -file [file join $tk_library demos/images/teapot.ppm] \
+ 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 [file join $tk_library demos/images/teapot.ppm] ppm]
+} [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]] \
@@ -85,11 +106,11 @@ test imgPhoto-2.2 {ImgPhotoCreate procedure} {
# } {couldn't open "bogus.img": no such file or directory}
test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} {
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
- p1 configure -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p1 -file $teapotPhotoFile
+ p1 configure -file $teapotPhotoFile
} {}
test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} {
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
+ 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}
@@ -98,7 +119,7 @@ test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} {
.c create image 10 10 -image p1 -tags p1.1 -anchor nw
.c create image 300 10 -image p1 -tags p1.2 -anchor nw
update
- p1 configure -file [file join $tk_library demos/images/teapot.ppm]
+ 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}}
@@ -113,7 +134,7 @@ test imgPhoto-4.1 {ImgPhotoCmd procedure} {
} {1 {wrong # args: should be "p1 option ?arg arg ...?"}}
test imgPhoto-4.2 {ImgPhotoCmd procedure} {
list [catch {p1 blah} err] $err
-} {1 {bad option "blah": must be blank, cget, configure, copy, get, put, read, redither, or write}}
+} {1 {bad option "blah": must be blank, cget, configure, copy, data, get, put, read, redither, or write}}
test imgPhoto-4.3 {ImgPhotoCmd procedure: blank option} {
p1 blank
list [catch {p1 blank x} err] $err
@@ -139,7 +160,7 @@ test imgPhoto-4.9 {ImgPhotoCmd procedure: configure option} {
list [catch {p1 configure -palette {} -gamma} msg] $msg
} {1 {value for "-gamma" missing}}
test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} {
- image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
+ 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]
@@ -198,7 +219,7 @@ test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} {
lappend result [image width p1] [image height p1]
} {256 256 49 51 49 51 49 51 10 51 10 10}
test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} {
- p1 read [file join $tk_library demos/images/teapot.ppm]
+ 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} {
@@ -212,7 +233,7 @@ test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} {
} {1 {wrong # args: should be "p1 get x y"}}
test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} {
list [catch {p1 put} err] $err
-} {1 {wrong # args: should be "p1 put data ?-format format? ?-to x1 y1 x2 y2?"}}
+} {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}}
@@ -225,28 +246,25 @@ test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} {
} {255 255 255}
test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} {
list [catch {p1 read} err] $err
-} {1 {wrong # args: should be "p1 read fileName ?-format format-name? ?-from x1 y1 x2 y2? ?-to x y? ?-shrink?"}}
+} {1 {wrong # args: should be "p1 read fileName ?options?"}}
test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} {
- list [catch {p1 read [file join $tk_library demos/images/teapot.ppm] \
- -zoom 2} err] $err
+ list [catch {p1 read $teapotPhotoFile -zoom 2} err] $err
} {1 {unrecognized option "-zoom": must be -format, -from, -shrink, or -to}}
test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} {
list [catch {p1 read bogus} err] [string tolower $err]
} {1 {couldn't open "bogus": no such file or directory}}
test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} {
- list [catch {p1 read [file join $tk_library demos/images/teapot.ppm] \
- -format bogus} err] $err
+ list [catch {p1 read $teapotPhotoFile -format bogus} err] $err
} {1 {image file format "bogus" is not supported}}
test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} {
list [catch {p1 read README} err] $err
} {1 {couldn't recognize data in image file "README"}}
test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} {
- p1 read [file join $tk_library demos/images/teapot.ppm] -shrink
+ p1 read $teapotPhotoFile
list [image width p1] [image height p1] [p1 get 120 120]
} {256 256 {161 109 82}}
test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} {
- p1 read [file join $tk_library demos/images/teapot.ppm] \
- -from 0 70 60 120 -to 10 10 -shrink
+ 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} {
@@ -255,7 +273,7 @@ test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} {
} {1 {wrong # args: should be "p1 redither"}}
test imgPhoto-4.38 {ImgPhotoCmd procedure: write option} {
list [catch {p1 write} err] $err
-} {1 {wrong # args: should be "p1 write fileName ?-format format-name??-from x1 y1 x2 y2?"}}
+} {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}}
@@ -263,7 +281,7 @@ test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} {
test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} {
eval image delete [image names]
.c delete all
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
+ 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
@@ -288,14 +306,14 @@ test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} {
test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} {
eval image delete [image names]
.c delete all
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p1 -file $teapotPhotoFile
.c create image 0 0 -image p1 -anchor nw
update
.c delete all
image delete p1
} {}
test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} {
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p1 -file $teapotPhotoFile
.c create image 10 10 -image p1 -anchor nw
button .b1 -image p1
button .b2 -image p1
@@ -311,7 +329,7 @@ test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} {
.c delete all
} {}
test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} {
- image create photo p1 -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p1 -file $teapotPhotoFile
button .b1 -image p1
frame .f -visual best
button .f.b2 -image p1
@@ -327,16 +345,16 @@ test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} {
} {}
test imgPhoto-8.1 {ImgPhotoDelete procedure} {
- image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p2 -file $teapotPhotoFile
image delete p2
} {}
test imagePhoto-8.2 {ImgPhotoDelete procedure} {
- image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
+ image create photo p2 -file $teapotPhotoFile
rename p2 newp2
set x [list [info command p2] [info command new*] [newp2 cget -file]]
image delete p2
- lappend x [info command new*]
-} [list {} newp2 [file join $tk_library demos/images/teapot.ppm] {}]
+ 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
@@ -345,7 +363,7 @@ test imagePhoto-8.3 {ImgPhotoDelete procedure, name cleanup} {
} {1 {image "p2" doesn't exist or is not a photo image}}
test imagePhoto-9.1 {ImgPhotoCmdDeletedProc procedure} {
- image create photo p2 -file [file join $tk_library demos/images/teapot.ppm]
+ 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"}}
@@ -353,8 +371,7 @@ test imagePhoto-9.1 {ImgPhotoCmdDeletedProc procedure} {
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 {{#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}}
@@ -367,7 +384,7 @@ test imgPhoto-11.1 {Tk_FindPhoto} {
} {1 {image "i1" doesn't exist or is not a photo image}}
test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} {
- image create photo p3 -file [file join $tk_library demos/images/teapot.ppm]
+ 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]
@@ -421,3 +438,23 @@ test imgPhoto-13.1 {check separation of images in different interpreters} {
destroy .c
eval image delete [image names]
+
+# cleanup
+if {[info exists removeREADME]} {
+ catch {file delete -force $newREADME}
+}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/listbox.test b/tk/tests/listbox.test
index 40e65d6218e..900ad1f963a 100644
--- a/tk/tests/listbox.test
+++ b/tk/tests/listbox.test
@@ -3,14 +3,14 @@
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
foreach i [winfo children .] {
destroy $i
@@ -88,7 +88,7 @@ foreach test {
{-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
{-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
{-highlightthickness -2 0 {} {}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-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"}}
@@ -98,6 +98,7 @@ foreach test {
{-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} {
@@ -238,7 +239,7 @@ test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} {
} {0}
test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} {
llength [.l configure]
-} {23}
+} {24}
test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} {
list [catch {.l configure -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
@@ -335,10 +336,10 @@ test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} {
} {el0 el1 el2 el3 el4 el5 el6 el7}
test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} {
list [catch {.l get} msg] $msg
-} {1 {wrong # args: should be ".l get first ?last?"}}
+} {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 first ?last?"}}
+} {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}}
@@ -481,7 +482,7 @@ test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} {
} {{0.249364 0.427481} {0.0714286 0.428571}}
test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} {
list [catch {.l scan foo 2 4} msg] $msg
-} {1 {bad scan option "foo": must be mark or dragto}}
+} {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"}}
@@ -618,7 +619,7 @@ test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} {
} {2 5 6 7}
test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} {
list [catch {.l selection badOption 0 0} msg] $msg
-} {1 {bad selection option "badOption": must be anchor, clear, includes, or set}}
+} {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"}}
@@ -740,19 +741,19 @@ test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} {
} {0.55 0.65}
test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} {
list [catch {.l whoknows} msg] $msg
-} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {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 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {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 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {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 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {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 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+} {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.
@@ -865,6 +866,83 @@ test listbox-4.8 {ConfigureListbox procedure} {
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 listvar value"]
# No tests for DisplayListbox: I don't know how to test this procedure.
@@ -1007,6 +1085,22 @@ test listbox-6.12 {InsertEls procedure} {fonts} {
.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
@@ -1163,6 +1257,13 @@ test listbox-7.20 {DeleteEls procedure} {fonts} {
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}
@@ -1649,6 +1750,309 @@ test listbox-20.1 {listbox vs hidden commands} {
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 darkblue 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 darkblue 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-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
+}
+
+# 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]
+
+
+
resetGridInfo
catch {destroy .l2}
catch {destroy .t}
@@ -1656,3 +2060,6 @@ catch {destroy .e}
catch {destroy .partial}
option clear
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tk/tests/macEmbed.test b/tk/tests/macEmbed.test
index 6765c37d375..74df7ad2a91 100644
--- a/tk/tests/macEmbed.test
+++ b/tk/tests/macEmbed.test
@@ -3,18 +3,13 @@
# tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "macintosh"} {
- return
-}
-
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
eval destroy [winfo children .]
@@ -22,11 +17,11 @@ wm geometry . {}
raise .
-test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {
+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} {
+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.}}
@@ -34,10 +29,11 @@ test macEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
if {[string compare testembed [info commands testembed]] != 0} {
puts "This application hasn't been compiled with the testembed command,"
puts "therefore I am skipping all of these tests."
+ ::tcltest::cleanupTests
return
}
-test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {
+test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} {
eval destroy [winfo child .]
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
@@ -46,7 +42,7 @@ test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {
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} {
+test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} {
eval destroy [winfo child .]
frame .f1 -container 1 -width 200 -height 50
frame .f2 -container 1 -width 200 -height 50
@@ -61,7 +57,7 @@ test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {
# Can't think of any way to test the procedures TkpMakeWindow,
# TkpMakeContainer, or EmbedErrorProc.
-test macEmbed-2.1 {EmbeddedEventProc procedure} {
+test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -74,7 +70,7 @@ test macEmbed-2.1 {EmbeddedEventProc procedure} {
update
testembed
} {}
-test macEmbed-2.2 {EmbeddedEventProc procedure} {
+test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -85,7 +81,7 @@ test macEmbed-2.2 {EmbeddedEventProc procedure} {
destroy .f1
testembed
} {}
-test macEmbed-2.3 {EmbeddedEventProc procedure} {
+test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -98,7 +94,7 @@ test macEmbed-2.3 {EmbeddedEventProc procedure} {
list [testembed] [winfo children .]
} {{} {}}
-test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {
+test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -110,7 +106,8 @@ test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {
wm withdraw .t1
list $x [testembed]
} {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}}
-test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} {
+test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \
+ {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -123,7 +120,8 @@ test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} {
update
wm geometry .t1
} {200x200+0+0}
-test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} {
+test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \
+ {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -136,7 +134,7 @@ test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} {
update
wm geometry .t1
} {300x100+0+0}
-test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {
+test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -148,7 +146,7 @@ test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {
update
list [winfo width .t1] [winfo height .t1] [wm geometry .t2]
} {300 80 300x80+0+0}
-test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {
+test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -163,7 +161,7 @@ test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {
update
set x
} {mapped}
-test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {
+test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -179,7 +177,7 @@ test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {
list $x [winfo exists .f1]
} {dead 0}
-test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {
+test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -192,7 +190,7 @@ test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {
update
winfo geometry .t1
} {180x100+0+0}
-test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
+test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -208,7 +206,7 @@ test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
# Can't think up any tests for TkpGetOtherWindow procedure.
-test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} {
+test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} {
catch {interp delete child}
foreach w [winfo child .] {
catch {destroy $w}
@@ -233,7 +231,7 @@ test unixEmbed-5.1 {TkpClaimFocus procedure} {tempNotMac} {
} {{{} .} .f1}
catch {interp delete child}
-test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {
+test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -250,7 +248,7 @@ test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {
}
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} {
+test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -265,7 +263,7 @@ test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {
lappend x [testembed]
} {{{XXX .f1 XXX .t1}} {}}
-test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
+test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -277,7 +275,7 @@ test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
update
wm geometry .t1
} {150x80+0+0}
-test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
+test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -295,3 +293,20 @@ test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
foreach w [winfo child .] {
catch {destroy $w}
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/macFont.test b/tk/tests/macFont.test
index e0636aa4023..5bbe38b115c 100644
--- a/tk/tests/macFont.test
+++ b/tk/tests/macFont.test
@@ -7,28 +7,30 @@
# but there are no results that can be checked.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform)!="macintosh"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-if {[string compare test [info procs test]] != 0} {
- source defs
+if {$tcl_platform(platform)!="macintosh"} {
+ puts "skipping: Mac only tests..."
+ ::tcltest::cleanupTests
+ return
}
catch {destroy .b}
toplevel .b
update idletasks
-set courier {Courier 10}
+set courier {Courier 12}
set cx [font measure $courier 0]
-label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font "Monaco 9"
+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
@@ -43,125 +45,226 @@ proc getsize {} {
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}
-test macfont-1.1 {TkpGetNativeFont procedure: not native} {
+set ::tcltest::testConfig(gothic) 0
+set gothic {gothic 12}
+set mx [font measure $gothic \u4e4e]
+if {[font actual $gothic -family] != [font actual system -family]} {
+ set ::tcltest::testConfig(gothic) 1
+}
+
+test macFont-1.1 {TkpFontPkgInit} {
+} {}
+
+test macfont-2.1 {TkpGetNativeFont: not native} {
list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
-test macfont-1.2 {TkpGetNativeFont procedure: native} {
+test macFont-2.2 {TkpGetNativeFont: native} {
font measure system "0"
font measure application "0"
set x {}
} {}
-test macfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
+test macFont-3.1 {TkpGetFontFromAttributes: no family} {
font actual {-underline 1} -family
} [font actual system -family]
-test macfont-2.2 {TkpGetFontFromAttributes procedure: long family name} {
+test macFont-3.2 {TkpGetFontFromAttributes: long family name} {
set x "12345678901234567890123456789012345678901234567890"
set x "$x$x$x$x$x$x"
font actual "-family $x" -family
} [font actual system -family]
-test macfont-2.3 {TkpGetFontFromAttributes procedure: family} {
+test macFont-3.3 {TkpGetFontFromAttributes: family} {
font actual {-family Courier} -family
} {Courier}
-test macfont-2.4 {TkpGetFontFromAttributes procedure: Times fonts} {
+test macFont-3.4 {TkpGetFontFromAttributes: Times fonts} {
set x {}
lappend x [font actual {-family "Times"} -family]
lappend x [font actual {-family "Times New Roman"} -family]
} {Times Times}
-test macfont-2.5 {TkpGetFontFromAttributes procedure: Courier fonts} {
+test macFont-3.5 {TkpGetFontFromAttributes: Courier fonts} {
set x {}
lappend x [font actual {-family "Courier"} -family]
lappend x [font actual {-family "Courier New"} -family]
} {Courier Courier}
-test macfont-2.6 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
+test macFont-3.6 {TkpGetFontFromAttributes: Helvetica fonts} {
set x {}
lappend x [font actual {-family "Geneva"} -family]
lappend x [font actual {-family "Helvetica"} -family]
lappend x [font actual {-family "Arial"} -family]
} {Geneva Helvetica Helvetica}
-test macfont-2.7 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.7 {TkpGetFontFromAttributes: try aliases} {
+ font actual {arial 10} -family
+} {Helvetica}
+test macFont-3.8 {TkpGetFontFromAttributes: try fallbacks} {
+ font actual {{ms sans serif} 10} -family
+} {Chicago}
+test macFont-3.9 {TkpGetFontFromAttributes: styles} {
font actual {-weight normal} -weight
} {normal}
-test macfont-2.8 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.10 {TkpGetFontFromAttributes: styles} {
font actual {-weight bold} -weight
} {bold}
-test macfont-2.9 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.11 {TkpGetFontFromAttributes: styles} {
font actual {-slant roman} -slant
} {roman}
-test macfont-2.10 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.12 {TkpGetFontFromAttributes: styles} {
font actual {-slant italic} -slant
} {italic}
-test macfont-2.11 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.13 {TkpGetFontFromAttributes: styles} {
font actual {-underline false} -underline
} {0}
-test macfont-2.12 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.14 {TkpGetFontFromAttributes: styles} {
font actual {-underline true} -underline
} {1}
-test macfont-2.13 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.15 {TkpGetFontFromAttributes: styles} {
font actual {-overstrike false} -overstrike
} {0}
-test macfont-2.14 {TkpGetFontFromAttributes procedure: styles} {
+test macFont-3.16 {TkpGetFontFromAttributes: styles} {
font actual {-overstrike true} -overstrike
} {0}
-test macfont-3.1 {TkpDeleteFont procedure} {
+test macFont-4.1 {TkpDeleteFont} {
font actual {-family xyz}
set x {}
} {}
-test macfont-4.1 {TkpGetFontFamilies procedure} {
- font families
- set x {}
-} {}
+test macFont-5.1 {TkpGetFontFamilies} {
+ expr {[lsearch [font families] Geneva] > 0}
+} {1}
+
+test macFont-6.1 {TkpGetSubFonts} {gothic} {
+ .b.l config -text "abc\u4e4e"
+ update
+ set x [testfont subfonts $fixed]
+} "Monaco [font actual $gothic -family]"
-test macfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
+test macFont-7.1 {Tk_MeasureChars: unbounded right margin} {
.b.l config -wrap 0 -text "000000"
getsize
} "[expr $ax*6] $ay"
-test macfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
+test macFont-7.2 {Tk_MeasureChars: static width buffer exceeded} {
.b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
getsize
} "[expr $ax*256] $ay"
-test macfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
+test macFont-7.3 {Tk_MeasureChars: all chars did fit} {
.b.l config -wrap [expr $ax*10] -text "00000000"
getsize
} "[expr $ax*8] $ay"
-test macfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
+test macFont-7.4 {Tk_MeasureChars: not all chars fit} {
.b.l config -wrap [expr $ax*6] -text "00000000"
getsize
} "[expr $ax*6] [expr $ay*2]"
-test macfont-5.5 {Tk_MeasureChars procedure: already saw space in line} {
+test macFont-7.5 {Tk_MeasureChars: already saw space in line} {
.b.l config -wrap [expr $ax*12] -text "000000 0000000"
getsize
} "[expr $ax*7] [expr $ay*2]"
-test macfont-5.6 {Tk_MeasureChars procedure: internal spaces significant} {
+test macFont-7.6 {Tk_MeasureChars: internal spaces significant} {
.b.l config -wrap [expr $ax*12] -text "000 00 00000"
getsize
} "[expr $ax*7] [expr $ay*2]"
-test macfont-5.7 {Tk_MeasureChars procedure: include last partial char} {
+test macFont-7.7 {Tk_MeasureChars: include last partial char} {
.b.c dchars $t 0 end
.b.c insert $t 0 "0000"
.b.c index $t @[expr int($ax*2.5)],1
} {2}
-test macfont-5.8 {Tk_MeasureChars procedure: at least one char on line} {
+test macFont-7.8 {Tk_MeasureChars: at least one char on line} {
.b.l config -text "000000" -wrap 1
getsize
} "$ax [expr $ay*6]"
-test macfont-5.9 {Tk_MeasureChars procedure: whole words} {
+test macFont-7.9 {Tk_MeasureChars: whole words} {
.b.l config -wrap [expr $ax*8] -text "000000 0000"
getsize
} "[expr $ax*6] [expr $ay*2]"
-test macfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
+test macFont-7.10 {Tk_MeasureChars: make first part of word fit} {
.b.l config -wrap [expr $ax*12] -text "0000000000000000"
getsize
} "[expr $ax*12] [expr $ay*2]"
+test macFont-7.11 {Tk_MeasureChars: numBytes == 0} {
+ font measure system {}
+} {0}
+test macFont-7.12 {Tk_MeasureChars: maxLength < 0} {
+ font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.13 {Tk_MeasureChars: loop on each char} {
+ font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.14 {Tk_MeasureChars: p == end} {
+ font measure $courier abcd
+} "[expr $cx*4]"
+test macFont-7.15 {Tk_MeasureChars: p > end} {
+ font measure $courier abc\xc2
+} "[expr $cx*4]"
+test macFont-7.16 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} {
+ font measure $courier abc\u4e4edef
+} [expr $cx*6+$mx]
+test macFont-7.17 {Tk_MeasureChars: measure no chars (in loop)} {gothic} {
+ font measure $courier \u4e4edef
+} [expr $mx+$cx*3]
+test macFont-7.18 {Tk_MeasureChars: final measure} {gothic} {
+ font measure $courier \u4e4edef
+} [expr $mx+$cx*3]
+test macFont-7.19 {Tk_MeasureChars: final measure (no chars)} {gothic} {
+ font measure $courier \u4e4e
+} [expr $mx]
+test macFont-7.20 {Tk_MeasureChars: maxLength >= 0} {
+ .b.l config -wrap [expr $ax*8] -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.21 {Tk_MeasureChars: loop on each char} {
+ .b.l config -wrap [expr $ax*8] -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.22 {Tk_MeasureChars: p == end} {
+ .b.l config -wrap [expr $ax*8] -text "000"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.23 {Tk_MeasureChars: p > end} {
+ .b.l config -wrap [expr $ax*8] -text "00\xc2"
+ getsize
+} "[expr $ax*3] $ay"
+test macFont-7.24 {Tk_MeasureChars: thisFamilyPtr != lastFamilyPtr} {gothic} {
+ .b.l config -wrap [expr $ax*8] -text "00\u4e4e00"
+ getsize
+} "[expr $ax*4+$mx] $ay"
+test macFont-7.25 {Tk_MeasureChars: measure no chars (in loop)} {gothic} {
+ .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
+ getsize
+} "[expr $mx+$ax*2] $ay"
+test macFont-7.26 {Tk_MeasureChars: rest == NULL} {gothic} {
+ .b.l config -wrap [expr $ax*20] -text "000000\u4e4e\u4e4e00"
+ getsize
+} "[expr $ax*8+$mx*2] $ay"
+test macFont-7.27 {Tk_MeasureChars: rest != NULL in first segment} {gothic} {
+ .b.l config -wrap [expr $ax*5] -text "000000\u4e4e\u4e4f00"
+ getsize
+} "[expr $ax*5] [expr $ay*3]"
+test macFont-7.28 {Tk_MeasureChars: rest != NULL in next segment} {gothic} {
+ # even some of the "0"s would fit after \u4e4d, they should all wrap to next line.
+ .b.l config -wrap [expr $ax*8] -text "\u4e4d\u4e4d000000\u4e4e\u4e4f00"
+ getsize
+} "[expr $ax*6+$mx] [expr $ay*3]"
+test macFont-7.29 {Tk_MeasureChars: final measure} {gothic} {
+ .b.l config -wrap [expr $ax*8] -text "\u4e4e00"
+ getsize
+} "[expr $mx+$ax*2] $ay"
+test macFont-7.30 {Tk_MeasureChars: final measure (no chars)} {gothic} {
+ .b.l config -wrap [expr $ax*8] -text "\u4e4e"
+ getsize
+} "$mx $ay"
+test macFont-7.31 {Tk_MeasureChars: rest == NULL} {
+ .b.l config -wrap [expr $ax*1000] -text 0000
+ getsize
+} "[expr $ax*4] $ay"
+test macFont-7.32 {Tk_MeasureChars: rest != NULL} {
+ .b.l config -wrap [expr $ax*6] -text "00000000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
-test macfont-6.1 {Tk_DrawChars procedure} {
+test macFont-8.1 {Tk_DrawChars procedure} {
.b.l config -text "a"
update
} {}
-test macfont-7.1 {AllocMacFont procedure: use old font} {
+test macFont-9.1 {AllocMacFont: use old font} {
font create xyz
button .c -font xyz
font configure xyz -family times
@@ -169,14 +272,31 @@ test macfont-7.1 {AllocMacFont procedure: use old font} {
destroy .c
font delete xyz
} {}
-test macfont-7.2 {AllocMacFont procedure: extract info from style} {
+test macFont-9.2 {AllocMacFont: extract info from style} {
font actual {Monaco 9 bold italic underline overstrike}
} {-family Monaco -size 9 -weight bold -slant italic -underline 1 -overstrike 0}
-test macfont-7.3 {AllocMacFont procedure: extract text metrics} {
+test macFont-9.3 {AllocMacFont: extract text metrics} {
font metric {Geneva 10} -fixed
} {0}
-test macfont-7.4 {AllocMacFont procedure: extract text metrics} {
+test macFont-9.4 {AllocMacFont: extract text metrics} {
font metric "Monaco 9" -fixed
} {1}
destroy .b
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/macMenu.test b/tk/tests/macMenu.test
index 0cd39899dca..0cbed04c75d 100644
--- a/tk/tests/macMenu.test
+++ b/tk/tests/macMenu.test
@@ -4,13 +4,18 @@
# system.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {$tcl_platform(platform) != "macintosh"} {
+ puts "skipping: Mac only tests..."
+ ::tcltest::cleanupTests
return
}
@@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
proc deleteWindows {} {
foreach i [winfo children .] {
catch [destroy $i]
@@ -1561,5 +1563,20 @@ test macMenu-44.2 {DrawMenuEntryBackground} {
test macMenu-45.1 {TkpMenuInit - called at boot time} {} {}
+# cleanup
deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/macWinMenu.test b/tk/tests/macWinMenu.test
index 013138f4f6f..8e59d00ce57 100644
--- a/tk/tests/macWinMenu.test
+++ b/tk/tests/macWinMenu.test
@@ -3,26 +3,27 @@
# the common implementation of Macintosh and Windows menus.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) == "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+ [expr {$::tcltest::testConfig(userInteraction) || \
+ $::tcltest::testConfig(unixOnly)}]
proc deleteWindows {} {
foreach i [winfo children .] {
@@ -34,33 +35,26 @@ deleteWindows
wm geometry . {}
raise .
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
-}
-
-test macWinMenu-1.1 {PreprocessMenu} {
+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 {}}
-if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} {
- test macWinMenu-1.2 {PreprocessMenu} {
- catch {destroy .m1}
- catch {destroy .m2}
- set foo1 foo
- set foo2 foo
- menu .m1 -postcommand "set foo1 .m1"
- .m1 add cascade -menu .m2 -label "macWinMenu-1.2: Hit Escape"
- menu .m2 -postcommand "set foo2 .m2"
- update idletasks
- list [catch {.m1 post 40 40} msg] $msg [set foo1] [set foo2] [destroy .m1 .m2] [catch {unset foo1}] [catch {unset foo2}]
- } {0 .m2 .m1 .m2 {} 0 0}
-}
-test macWinMenu-1.3 {PreprocessMenu} {
+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}
@@ -76,7 +70,7 @@ test macWinMenu-1.3 {PreprocessMenu} {
update idletasks
list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3]
} {0 {} {}}
-test macWinMenu-1.4 {PreprocessMenu} {
+test macWinMenu-1.4 {PreprocessMenu} {macOrPc} {
catch {destroy .l1}
catch {destroy .m1}
catch {destroy .m2}
@@ -95,7 +89,7 @@ test macWinMenu-1.4 {PreprocessMenu} {
update idletasks
list [catch {.m1 post 40 40} msg] $msg [destroy .l1 .m2 .m3 .m4]
} {0 {} {}}
-test macWinMenu-1.5 {PreprocessMenu} {
+test macWinMenu-1.5 {PreprocessMenu} {macOrPc} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -104,14 +98,28 @@ test macWinMenu-1.5 {PreprocessMenu} {
list [catch {.m1 post 40 40} msg] $msg [destroy .m1 .m2]
} {1 {invalid command name "glorp"} {}}
-if {$tcl_platform(platform) != "windows" || [info exists INTERACTIVE]} {
- test macWinMenu-2.1 {TkPreprocessMenu} {
- catch {destroy .m1}
- set foo test
- menu .m1 -postcommand "set foo 2.1"
- .m1 add command -label "macWinMenu-2.1: Hit Escape"
- list [catch {.m1 post 40 40} msg] $msg [set foo] [destroy .m1] [unset foo]
- } {0 2.1 2.1 {} {}}
-}
+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/tk/tests/macscrollbar.test b/tk/tests/macscrollbar.test
index 24f49362d9f..4ebfd79f2af 100644
--- a/tk/tests/macscrollbar.test
+++ b/tk/tests/macscrollbar.test
@@ -4,17 +4,20 @@
# Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-# Only run this test on the Macintosh
-if {$tcl_platform(platform) != "macintosh"} return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
-if {[info procs test] != "test"} {
- source defs
+# Only run this test on the Macintosh
+if {$tcl_platform(platform) != "macintosh"} {
+ puts "skipping: Mac only tests..."
+ ::tcltest::cleanupTests
+ return
}
foreach i [winfo children .] {
@@ -98,4 +101,20 @@ test macscroll-1.7 {TkpDisplayScrollbar procedure} {
foreach i [winfo children .] {
destroy $i
}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/main.test b/tk/tests/main.test
index 21bd20956ee..56b6690e328 100644
--- a/tk/tests/main.test
+++ b/tk/tests/main.test
@@ -5,14 +5,13 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
test main-1.1 {StdinProc} {unixOnly} {
@@ -22,10 +21,29 @@ test main-1.1 {StdinProc} {unixOnly} {
close stdin; exit
}
close $fd
- if {[catch {exec $tktest <script} msg]} {
+ if {[catch {exec $::tcltest::tktest <script} msg]} {
set error 1
} else {
set error 0
}
+ file delete -force script
list $error $msg
} {0 {}}
+
+# cleanup
+catch {removeFile script}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/menu.test b/tk/tests/menu.test
index cc07d9269e2..a0163f73f67 100644
--- a/tk/tests/menu.test
+++ b/tk/tests/menu.test
@@ -2,32 +2,27 @@
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
- set testConfig(menuInteractive) 0
-} else {
- set testConfig(menuInteractive) 1
-}
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+ [expr {$::tcltest::testConfig(userInteraction) || \
+ $::tcltest::testConfig(unixOnly)}]
proc deleteWindows {} {
foreach i [winfo children .] {
@@ -164,16 +159,16 @@ test menu-1.14 {Tk_MenuCmd procedure} {
catch {destroy .m1}
menu .m1
set i 1
-foreach test {
+foreach configTest {
{-activebackground #012345 #012345 non-existent
{unknown color name "non-existent"}}
- {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-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 badValue {bad screen distance "badValue"}}
+ {-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"}}
@@ -182,23 +177,27 @@ foreach test {
{font "" doesn't exist}}
{-foreground #110022 #110022 bogus {unknown color name "bogus"}}
{-postcommand "any old string" "any old string" {} {}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-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 $test 0]
- test menu-2.$i {configuration options} {
- .m1 configure $name [lindex $test 1]
+ 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
- } [lindex $test 2]
+ } $result
incr i
- if {[lindex $test 3] != ""} {
- test menu-2.$i {configuration options} {
- list [catch {.m1 configure $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ 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
@@ -221,7 +220,7 @@ menu .m2
.m1 add radiobutton -label "radiobutton" -variable radio
image create photo image1 -file [file join $tk_library demos images earth.gif]
-foreach test {
+foreach configTest {
{-activebackground
{{#012345
{{unknown option "-activebackground"} #012345 #012345
@@ -240,7 +239,7 @@ foreach test {
}
{-activeforeground
{{#ff0000
- {{unknown option "-activeforeground"}
+ {{unknown option "-activeforeground"}
#ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
}
}
@@ -256,7 +255,7 @@ foreach test {
}
{-accelerator
{{"Ctrl+S"
- {{unknown option "-accelerator"}
+ {{unknown option "-accelerator"}
"Ctrl+S" "Ctrl+S" {unknown option "-accelerator"}
"Ctrl+S" "Ctrl+S"
}
@@ -279,8 +278,8 @@ foreach test {
}
{-bitmap
{{questhead
- {{unknown option "-bitmap"} questhead questhead
- {unknown option "-bitmap"} questhead questhead
+ {{unknown option "-bitmap"} questhead questhead
+ {unknown option "-bitmap"} questhead questhead
}
}
{badValue
@@ -295,22 +294,23 @@ foreach test {
}
{-columnbreak
{{1
- {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1}
+ {{unknown option "-columnbreak"} 1 1
+ {unknown option "-columnbreak"} 1 1}
}}
}
{-command
{{beep
- {{unknown option "-command"} beep beep
- {unknown option "-command"} beep beep
+ {{unknown option "-command"} beep beep
+ {unknown option "-command"} beep beep
}
}}
}
{-font
{{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
- {{unknown option "-font"}
+ {{unknown option "-font"}
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
- {unknown option "-font"}
+ {unknown option "-font"}
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
}
@@ -327,8 +327,8 @@ foreach test {
}
{-foreground
{{#110022
- {{unknown option "-foreground"} #110022 #110022
- {unknown option "-foreground"} #110022 #110022
+ {{unknown option "-foreground"} #110022 #110022
+ {unknown option "-foreground"} #110022 #110022
}
}
{non-existent
@@ -343,8 +343,8 @@ foreach test {
}
{-image
{{image1
- {{unknown option "-image"} image1 image1
- {unknown option "-image"} image1 image1
+ {{unknown option "-image"} image1 image1
+ {unknown option "-image"} image1 image1
}
}
{bogus
@@ -368,58 +368,58 @@ foreach test {
}
{-indicatoron
{{1
- {{unknown option "-indicatoron"}
- {unknown option "-indicatoron"}
- {unknown option "-indicatoron"}
- {unknown option "-indicatoron"} 1 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
+ {{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"}
+ {{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"}
+ {unknown option "-offvalue"}
{unknown option "-offvalue"}
- {unknown option "-offvalue"}
off
- {unknown option "-offvalue"}
+ {unknown option "-offvalue"}
}
}}
}
{-onvalue
{{on
- {{unknown option "-onvalue"}
- {unknown option "-onvalue"}
- {unknown option "-onvalue"}
- {unknown option "-onvalue"}
+ {{unknown option "-onvalue"}
+ {unknown option "-onvalue"}
+ {unknown option "-onvalue"}
+ {unknown option "-onvalue"}
on
- {unknown option "-onvalue"}
+ {unknown option "-onvalue"}
}
}}
}
{-selectcolor
{{#110022
- {{unknown option "-selectcolor"}
- {unknown option "-selectcolor"}
- {unknown option "-selectcolor"}
- {unknown option "-selectcolor"}
+ {{unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
#110022
#110022
}
@@ -463,8 +463,7 @@ foreach test {
}
{-state
{{normal
- {normal normal normal
- {unknown option "-state"} normal normal
+ {normal normal normal {unknown option "-state"} normal normal
}
}}
}
@@ -506,13 +505,13 @@ foreach test {
}}
}
} {
- set name [lindex $test 0]
- foreach attempt [lindex $test 1] {
+ 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] {
+ 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
@@ -534,7 +533,7 @@ test menu-3.1 {MenuWidgetCmd procedure} {
menu .m1
list [catch {.m1} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
-test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
+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"
@@ -551,21 +550,21 @@ test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
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} {
+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} {
+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} {
+test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -805,7 +804,7 @@ test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
menu .m1
list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
} {1 {expected integer but got "bar"} {}}
-test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
+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"
@@ -821,7 +820,7 @@ test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
menu .m1
list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
-test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {menuInteractive} {
+test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -890,7 +889,7 @@ test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
menu .m1
list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 unpost"} {}}
-test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {menuInteractive} {
+test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } {
catch {destroy .m1}
menu .m1
.m1 add command -label "menu-3.68 - hit Escape"
@@ -913,19 +912,27 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} {
list [catch {.m1 foo} msg] $msg [destroy .m1]
} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
-test menu-4.1 {TkInvokeMenu} {
+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.2 {TkInvokeMenu} {
+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.3 {TkInvokeMenu} {
+test menu-4.4 {TkInvokeMenu: checkbutton -off} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -933,7 +940,14 @@ test menu-4.3 {TkInvokeMenu} {
.m1 invoke 1
list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 off 0 {} {}}
-test menu-4.4 {TkInvokeMenu} {
+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
@@ -942,7 +956,7 @@ test menu-4.4 {TkInvokeMenu} {
.m1 add radiobutton -label "3" -variable foo -value three
list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 one 0 {} {}}
-test menu-4.5 {TkInvokeMenu} {
+test menu-4.7 {TkInvokeMenu: radiobutton} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -951,7 +965,7 @@ test menu-4.5 {TkInvokeMenu} {
.m1 add radiobutton -label "3" -variable foo -value three
list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 two 0 {} {}}
-test menu-4.6 {TkInvokeMenu} {
+test menu-4.8 {TkInvokeMenu: radiobutton} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -960,20 +974,29 @@ test menu-4.6 {TkInvokeMenu} {
.m1 add radiobutton -label "3" -variable foo -value three
list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 three 0 {} {}}
-test menu-4.7 {TkInvokeMenu} {
+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.8 {TkInvokeMenu} {
+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.9 {TkInvokeMenu} {
+test menu-4.12 {TkInvokeMenu} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test" -command ".m1 delete 1"
@@ -1431,44 +1454,60 @@ test menu-9.9 {ConfigureMenu} {
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-10.1 {ConfigureMenuEntry} {
+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-10.2 {ConfigureMenuEntry} {
+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-10.3 {ConfigureMenuEntry} {
+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-10.4 {ConfigureMenuEntry} {
+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-10.5 {ConfigureMenuEntry} {
+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-10.6 {ConfigureMenuEntry} {
+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-10.7 {ConfigureMenuEntry} {
+test menu-11.7 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {destroy .m2}
menu .m2
@@ -1476,31 +1515,31 @@ test menu-10.7 {ConfigureMenuEntry} {
.m1 add cascade
list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-10.8 {ConfigureMenuEntry} {
+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-10.9 {ConfigureMenuEntry} {
+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-10.10 {ConfigureMenuEntry} {
+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-10.11 {ConfigureMenuEntry} {
+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-10.12 {ConfigureMenuEntry} {
+test menu-11.12 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1517,7 +1556,7 @@ test menu-10.12 {ConfigureMenuEntry} {
.m5 add cascade
list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
} {0 {} {}}
-test menu-10.13 {ConfigureMenuEntry} {
+test menu-11.13 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1531,29 +1570,29 @@ test menu-10.13 {ConfigureMenuEntry} {
.m4 add cascade -menu .m1
list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
} {0 {} {}}
-test menu-10.14 {ConfigureMenuEntry} {
+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-10.15 {ConfigureMenuEntry} {
+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-10.16 {ConfigureMenuEntry} {
+test menu-11.16 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.17 {ConfigureMenuEntry} {
+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-10.18 {ConfigureMenuEntry} {
+test menu-11.18 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -1561,7 +1600,7 @@ test menu-10.18 {ConfigureMenuEntry} {
image create test image1
list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
-test menu-10.19 {ConfigureMenuEntry} {
+test menu-11.19 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1571,7 +1610,7 @@ test menu-10.19 {ConfigureMenuEntry} {
.m1 add command -image image1
list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
-test menu-10.20 {ConfigureMenuEntry} {
+test menu-11.20 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1581,7 +1620,7 @@ test menu-10.20 {ConfigureMenuEntry} {
.m1 add checkbutton -image image1
list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
-test menu-10.21 {ConfigureMenuEntry} {
+test menu-11.21 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1594,7 +1633,7 @@ test menu-10.21 {ConfigureMenuEntry} {
list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
} {0 {} {} {} {} {}}
-test menu-11.1 {ConfigureMenuCloneEntries} {
+test menu-12.1 {ConfigureMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1606,7 +1645,7 @@ test menu-11.1 {ConfigureMenuCloneEntries} {
.m1 add command -label "test2"
list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
} {{1 {unknown option "-gork"}} {}}
-test menu-11.2 {ConfigureMenuCloneEntries} {
+test menu-12.2 {ConfigureMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1618,7 +1657,7 @@ test menu-11.2 {ConfigureMenuCloneEntries} {
menu .m4
list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
} {0 {} {} {} {}}
-test menu-11.3 {ConfigureMenuCloneEntries} {
+test menu-12.3 {ConfigureMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -1627,7 +1666,18 @@ test menu-11.3 {ConfigureMenuCloneEntries} {
list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-12.1 {TkGetMenuIndex} {
+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"
@@ -1636,7 +1686,7 @@ test menu-12.1 {TkGetMenuIndex} {
.m1 activate 2
list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
} {0 test2 {}}
-test menu-12.2 {TkGetMenuIndex} {
+test menu-13.2 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "last"
@@ -1645,7 +1695,7 @@ test menu-12.2 {TkGetMenuIndex} {
.m1 activate 2
list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
} {0 test3 {}}
-test menu-12.3 {TkGetMenuIndex} {
+test menu-13.3 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "last"
@@ -1654,19 +1704,19 @@ test menu-12.3 {TkGetMenuIndex} {
.m1 activate 2
list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
} {0 test3 {}}
-test menu-12.4 {TkGetMenuIndex} {
+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-12.5 {TkGetMenuIndex} {
+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-12.6 {TkGetMenuIndex} {
+test menu-13.6 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "active"
@@ -1676,7 +1726,7 @@ test menu-12.6 {TkGetMenuIndex} {
list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
} {0 {} {}}
#test menu-13.7 - Need to add @test here.
-test menu-12.7 {TkGetMenuIndex} {
+test menu-13.7 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "active"
@@ -1684,32 +1734,32 @@ test menu-12.7 {TkGetMenuIndex} {
.m1 add command -label "test3"
list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 active {}}
-test menu-12.8 {TkGetMenuIndex} {
+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-12.9 {TkGetMenuIndex} {
+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-12.10 {TkGetMenuIndex} {
+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-12.11 {TkGetMenuIndex} {
+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-12.12 {TkGetMenuIndex} {
+test menu-13.12 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -1718,101 +1768,101 @@ test menu-12.12 {TkGetMenuIndex} {
list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
} {0 beep {}}
-test menu-13.1 {MenuCmdDeletedProc} {
+test menu-14.1 {MenuCmdDeletedProc} {
catch {destroy .m1}
menu .m1
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test menu-13.2 {MenuCmdDeletedProc} {
+test menu-14.2 {MenuCmdDeletedProc} {
catch {destroy .m1}
menu .m1
.m1 clone .m2
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test menu-14.1 {MenuNewEntry} {
+test menu-15.1 {MenuNewEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-14.2 {MenuNewEntry} {
+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-14.3 {MenuNewEntry} {
+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-14.4 {MenuNewEntry} {
+test menu-15.4 {MenuNewEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.1 {MenuAddOrInsert} {
+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-15.2 {MenuAddOrInsert} {
+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-15.3 {MenuAddOrInsert} {
+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-15.4 {MenuAddOrInsert} {
+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-15.5 {MenuAddOrInsert} {
+test menu-16.5 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add cascade} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.6 {MenuAddOrInsert} {
+test menu-16.6 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.7 {MenuAddOrInsert} {
+test menu-16.7 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.8 {MenuAddOrInsert} {
+test menu-16.8 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.9 {MenuAddOrInsert} {
+test menu-16.9 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add separator} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.10 {MenuAddOrInsert} {
+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-15.11 {MenuAddOrInsert} {
+test menu-16.11 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.12 {MenuAddOrInsert} {
+test menu-16.12 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1821,7 +1871,7 @@ test menu-15.12 {MenuAddOrInsert} {
.m2 clone .m3
list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
-test menu-15.13 {MenuAddOrInsert} {
+test menu-16.13 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1830,12 +1880,12 @@ test menu-15.13 {MenuAddOrInsert} {
.m2 clone .m3
list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
-test menu-15.14 {MenuAddOrInsert} {
+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-15.15 {MenuAddOrInsert} {
+test menu-16.15 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .container}
menu .m1
@@ -1844,7 +1894,7 @@ test menu-15.15 {MenuAddOrInsert} {
. configure -menu .container
list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
} {0 {} {} {}}
-test menu-15.16 {MenuAddOrInsert} {
+test menu-16.16 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -1852,7 +1902,7 @@ test menu-15.16 {MenuAddOrInsert} {
set tearoff [tkTearOffMenu .m2]
list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
} {0 {} {} 0 {} 0 {}}
-test menu-15.17 {MenuAddOrInsert} {
+test menu-16.17 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .container}
menu .m1
@@ -1861,7 +1911,7 @@ test menu-15.17 {MenuAddOrInsert} {
set tearoff [tkTearOffMenu .container]
list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
-test menu-15.18 {MenuAddOrInsert} {
+test menu-16.18 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .container}
menu .m1
@@ -1870,7 +1920,7 @@ test menu-15.18 {MenuAddOrInsert} {
. configure -menu .container
list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
-test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
+test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
catch {destroy .menubar}
menu .menubar
menu .menubar.test -tearoff 0
@@ -1884,7 +1934,7 @@ test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
[. configure -menu ""] [destroy .menubar]
} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
-test menu-16.1 {MenuVarProc} {
+test menu-17.1 {MenuVarProc} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -1892,45 +1942,45 @@ test menu-16.1 {MenuVarProc} {
list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
} {0 {} 0 {} {}}
# menu-17.2 - Don't know how to generate the flags in the if
-test menu-16.2 {MenuVarProc} {
+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-16.3 {MenuVarProc} {
+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-16.4 {MenuVarProc} {
+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-16.5 {MenuVarProc} {
+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-17.1 {TkActivateMenuEntry} {
+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-17.2 {TkActivateMenuEntry} {
+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-17.3 {TkActivateMenuEntry} {
+test menu-18.3 {TkActivateMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -1938,7 +1988,7 @@ test menu-17.3 {TkActivateMenuEntry} {
.m1 activate 1
list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-17.4 {TkActivateMenuEntry} {
+test menu-18.4 {TkActivateMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -1947,56 +1997,56 @@ test menu-17.4 {TkActivateMenuEntry} {
list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-18.1 {TkPostCommand} {menuInteractive} {
+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-18.2 {TkPostCommand} {menuInteractive} {
+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-19.1 {CloneMenu} {
+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-19.2 {CloneMenu} {
+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-19.3 {CloneMenu} {
+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-19.4 {CloneMenu} {
+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-19.5 {CloneMenu} {
+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 - must be normal, tearoff, or menubar} {}}
-test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
+} {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-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
+ test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -2004,14 +2054,14 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
.m1 clone .m2
list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
} {0 {} {}}
- test menu-19.8 {CloneMenu - cascade entries} {
+ 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-19.9 {CloneMenu - cascades entries} {
+ test menu-20.9 {CloneMenu - cascades entries} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .foo}
@@ -2020,13 +2070,13 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
menu .m2
list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-19.10 {CloneMenu - tearoff fields} {
+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-19.11 {CloneMenu} {
+test menu-20.11 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2034,26 +2084,26 @@ test menu-19.11 {CloneMenu} {
list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
} {1 {window name "m2" already exists in parent} {}}
-test menu-20.1 {MenuDoYPosition} {
+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-20.2 {MenuDoYPosition} {
+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-21.1 {GetIndexFromCoords} {
+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-21.2 {GetIndexFromCoords} {
+test menu-22.2 {GetIndexFromCoords} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -2061,13 +2111,13 @@ test menu-21.2 {GetIndexFromCoords} {
list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
} {0 0 {}}
-test menu-22.1 {RecursivelyDeleteMenu} {
+test menu-23.1 {RecursivelyDeleteMenu} {
catch {destroy .m1}
menu .m1
. configure -menu .m1
list [catch {. configure -menu ""} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-22.2 {RecursivelyDeleteMenu} {
+test menu-23.2 {RecursivelyDeleteMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m2
@@ -2078,40 +2128,40 @@ test menu-22.2 {RecursivelyDeleteMenu} {
list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-23.1 {TkNewMenuName} {
+test menu-24.1 {TkNewMenuName} {
catch {destroy .m1}
menu .m1
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-23.2 {TkNewMenuName} {
+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-23.3 {TkNewMenuName} {
+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-24.1 {TkSetWindowMenuBar} {
+test menu-25.1 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.2 {TkSetWindowMenuBar} {
+test menu-25.2 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.3 {TkSetWindowMenuBar} {
+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-24.4 {TkSetWindowMenuBar} {
+test menu-25.4 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
. configure -menu ""
@@ -2120,7 +2170,7 @@ test menu-24.4 {TkSetWindowMenuBar} {
menu .m2
list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}
-test menu-24.5 {TkSetWindowMenuBar} {
+test menu-25.5 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -2131,7 +2181,7 @@ test menu-24.5 {TkSetWindowMenuBar} {
menu .m3
list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
-test menu-24.6 {TkSetWindowMenuBar} {
+test menu-25.6 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -2142,7 +2192,7 @@ test menu-24.6 {TkSetWindowMenuBar} {
menu .m3
list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
-test menu-24.7 {TkSetWindowMenuBar} {
+test menu-25.7 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
. configure -menu ""
@@ -2153,7 +2203,7 @@ test menu-24.7 {TkSetWindowMenuBar} {
.t2 configure -menu .m1
list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
-test menu-24.8 {TkSetWindowMenuBar} {
+test menu-25.8 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2166,7 +2216,7 @@ test menu-24.8 {TkSetWindowMenuBar} {
.t2 configure -menu .m1
list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
-test menu-24.9 {TkSetWindowMenuBar} {
+test menu-25.9 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2181,7 +2231,7 @@ test menu-24.9 {TkSetWindowMenuBar} {
wm geometry .t3 +0+0
list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
-test menu-24.10 {TkSetWindowMenuBar} {
+test menu-25.10 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2196,7 +2246,7 @@ test menu-24.10 {TkSetWindowMenuBar} {
wm geometry .t3 +0+0
list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
-test menu-24.11 {TkSetWindowMenuBar} {
+test menu-25.11 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2211,27 +2261,27 @@ test menu-24.11 {TkSetWindowMenuBar} {
wm geometry .t3 +0+0
list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
-test menu-24.12 {TkSetWindowMenuBar} {
+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-24.13 {TkSetWindowMenuBar} {
+test menu-25.13 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.14 {TkSetWindowMenuBar} {
+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-24.15 {TkSetWindowMenuBar} {
+test menu-25.15 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.16 {TkSetWindowMenuBar} {
+test menu-25.16 {TkSetWindowMenuBar} {
catch {destroy .m1}
. configure -menu ""
menu .m1
@@ -2239,7 +2289,7 @@ test menu-24.16 {TkSetWindowMenuBar} {
list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
} {0 .t2 {} {}}
-test menu-25.1 {DestroyMenuHashTable} {
+test menu-26.1 {DestroyMenuHashTable} {
catch {interp destroy testinterp}
interp create testinterp
load {} Tk testinterp
@@ -2247,18 +2297,18 @@ test menu-25.1 {DestroyMenuHashTable} {
list [catch {interp delete testinterp} msg] $msg
} {0 {}}
-test menu-26.1 {GetMenuHashTable} {
+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-27.1 {TkCreateMenuReferences - not there before} {
+test menu-28.1 {TkCreateMenuReferences - not there before} {
catch {destroy .m1}
list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
-test menu-27.2 {TkCreateMenuReferences - there already} {
+test menu-28.2 {TkCreateMenuReferences - there already} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2266,14 +2316,14 @@ test menu-27.2 {TkCreateMenuReferences - there already} {
list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
} {0 .m2 {}}
-test menu-28.1 {TkFindMenuReferences - not there} {
+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-29.1 {TkFindMenuReferences - there already} {
+test menu-30.1 {TkFindMenuReferences - there already} {
catch {destroy .m1}
catch {destroy .m2}
. configure -menu ""
@@ -2283,23 +2333,23 @@ test menu-29.1 {TkFindMenuReferences - there already} {
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}
-test menu-30.1 {TkFreeMenuReferences - menuPtr} {
+test menu-31.1 {TkFreeMenuReferences - menuPtr} {
catch {destroy .m1}
menu .m1
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test menu-30.2 {TkFreeMenuReferences - cascadePtr} {
+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-30.3 {TkFreeMenuReferences - topLevelListPtr} {
+test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
. configure -menu .m1
list [catch {. configure -menu ""} msg] $msg
} {0 {}}
-test menu-30.4 {TkFreeMenuReferences - not empty} {
+test menu-31.4 {TkFreeMenuReferences - not empty} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2309,7 +2359,7 @@ test menu-30.4 {TkFreeMenuReferences - not empty} {
list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-31.1 {DeleteMenuCloneEntries} {
+test menu-32.1 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2317,7 +2367,7 @@ test menu-31.1 {DeleteMenuCloneEntries} {
.m1 clone .m2
list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.2 {DeleteMenuCloneEntries} {
+test menu-32.2 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2328,7 +2378,7 @@ test menu-31.2 {DeleteMenuCloneEntries} {
.m1 clone .m2
list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.3 {DeleteMenuCloneEntries} {
+test menu-32.3 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1 -tearoff 0
@@ -2340,7 +2390,7 @@ test menu-31.3 {DeleteMenuCloneEntries} {
.m2 configure -tearoff 1
list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.4 {DeleteMenuCloneEntries} {
+test menu-32.4 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2352,7 +2402,7 @@ test menu-31.4 {DeleteMenuCloneEntries} {
.m2 configure -tearoff 0
list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.5 {DeleteMenuCloneEntries} {
+test menu-32.5 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2362,17 +2412,23 @@ test menu-31.5 {DeleteMenuCloneEntries} {
.m1 activate one
list [catch {.m1 delete one} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
+test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
catch {destroy .m1}
menu .m1
.m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
list [catch {.m1 invoke test} msg] $msg [destroy .m1]
} {0 {} {}}
+test menu-32.7 {DeleteMenuCloneEntries - one entry} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
+} {0 {} {}}
set l [interp hidden]
eval destroy [winfo children .]
-test menu-32.1 {menu vs command hiding} {
+test menu-33.1 {menu vs command hiding} {
catch {destroy .m}
menu .m
interp hide {} .m
@@ -2382,4 +2438,22 @@ test menu-32.1 {menu vs command hiding} {
# 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} {
+ if {[info exists ::env(TK_ALT_DISPLAY)]} {
+ 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/tk/tests/menuDraw.test b/tk/tests/menuDraw.test
index 7a1b660df85..f6902a73e0d 100644
--- a/tk/tests/menuDraw.test
+++ b/tk/tests/menuDraw.test
@@ -2,23 +2,23 @@
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
proc deleteWindows {} {
foreach i [winfo children .] {
catch [destroy $i]
@@ -29,16 +29,6 @@ deleteWindows
wm geometry . {}
raise .
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
- set testConfig(menuInteractive) 0
-} else {
- set testConfig(menuInteractive) 1
-}
-
test menuDraw-1.1 {TkMenuInitializeDrawingFields} {
catch {destroy .m1}
list [menu .m1] [destroy .m1]
@@ -118,7 +108,7 @@ test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} {
menu .m1
.m1 add command -label "foo"
list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1]
-} {1 {bad state value "foo": must be normal, active, or disabled} {}}
+} {1 {bad state "foo": must be active, normal, or disabled} {}}
test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
catch {destroy .m1}
menu .m1
@@ -191,7 +181,7 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} {
} {{} {}}
-test menuDraw-8.1 {TkRecomputeMenu} {menuInteractive} {
+test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} {
catch {destroy .m1}
menu .m1
.m1 configure -postcommand [.m1 add command -label foo]
@@ -506,7 +496,7 @@ test menuDraw-16.5 {TkPostSubMenu} {unixOnly} {
set tearoff [tkTearOffMenu .m1 40 40]
list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
} {1 {invalid command name "glorp"} {} {}}
-test menuDraw-16.6 {TkPostSubMenu} {menuInteractive} {
+test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -532,7 +522,7 @@ test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} {
}
list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2]
} {{} {} {} {}}
-test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
+test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -543,4 +533,20 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}
+# cleanup
deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/menubut.test b/tk/tests/menubut.test
index eb510cfe823..a3031957544 100644
--- a/tk/tests/menubut.test
+++ b/tk/tests/menubut.test
@@ -3,9 +3,8 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
@@ -13,17 +12,18 @@
# XXX of a procedure has tests then the whole procedure has tests,
# XXX but many procedures have no tests.
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -51,7 +51,7 @@ foreach test {
{unknown color name "non-existent"}}
{-activeforeground #ff0000 #ff0000 non-existent
{unknown color name "non-existent"}}
- {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}}
+ {-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"}}
@@ -59,7 +59,7 @@ foreach test {
{-bitmap questhead questhead badValue {bitmap "badValue" not defined}}
{-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
{-cursor arrow arrow badValue {bad cursor spec "badValue"}}
- {-direction below below badValue {bad direction value "badValue": must be above, below, left, right, or flush}}
+ {-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}}
@@ -74,8 +74,8 @@ foreach test {
{-menu "any old string" "any old string" {} {}}
{-padx 12 12 420x {bad screen distance "420x"}}
{-pady 12 12 420x {bad screen distance "420x"}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
- {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}}
+ {-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 {} {}}
@@ -122,7 +122,7 @@ test menubutton-3.1 {MenuButtonWidgetCmd procedure} {
} {1 {wrong # args: should be ".mb option ?arg arg ...?"}}
test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} {
list [catch {.mb c} msg] $msg
-} {1 {bad option "c": must be cget or configure}}
+} {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"}}
@@ -191,7 +191,7 @@ test menubutton-4.4 {ConfigureMenuButton procedure} {
(processing -height option)
invoked from within
".mb1 configure -height 0.5x"}}
-test menubutton-4.5 {ConfigureMenuButton procedure} {fonts} {
+test menubutton-4.5 {ConfigureMenuButton procedure} {nonPortable fonts} {
catch {destroy .mb1}
button .mb1 -text "Sample text" -width 10 -height 2
pack .mb1
@@ -204,7 +204,7 @@ test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} {
menubutton .mb -text "Test"
list [catch {.mb configure -direction badValue} msg] $msg \
[.mb cget -direction] [destroy .mb]
-} {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}}
+} {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}}
# XXX Need to add tests for several procedures here. XXX
@@ -307,14 +307,14 @@ test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} {
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {62 30}
-test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} {
+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} {unix nonPortable} {
+test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} {
# The following test is non-portable because the indicator's pixel
# size varies to maintain constant absolute size.
@@ -324,7 +324,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} {
pack .mb
list [winfo reqwidth .mb] [winfo reqheight .mb]
} {64 23}
-test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} {
+test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} {
# The following test is non-portable because the indicator's pixel
# size varies to maintain constant absolute size.
@@ -350,3 +350,19 @@ eval image delete [image names]
eval destroy [winfo children .]
option clear
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/msgbox.test b/tk/tests/msgbox.test
index 26b4746c2f6..d1be52d21e3 100644
--- a/tk/tests/msgbox.test
+++ b/tk/tests/msgbox.test
@@ -2,23 +2,27 @@
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
#
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+ [expr {$::tcltest::testConfig(userInteraction) || \
+ $::tcltest::testConfig(unixOnly)}]
+
test msgbox-1.1 {tk_messageBox command} {
list [catch {tk_messageBox -foo} msg] $msg
-} {1 {unknown option "-foo", must be -default, -icon, -message, -modal, -parent, -title or -type}}
+} {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 {unknown option "-foo", must be -default, -icon, -message, -modal, -parent, -title or -type}}
+} {1 {bad option "-foo": must be -default, -icon, -message, -parent, -title, or -type}}
catch {tk_messageBox -foo bar} msg
regsub -all , $msg "" options
@@ -38,23 +42,31 @@ test msgbox-1.4 {tk_messageBox command} {
test msgbox-1.5 {tk_messageBox command} {
list [catch {tk_messageBox -type foo} msg] $msg
-} {1 {invalid message box type "foo", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel}}
+} {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
-} {1 {invalid default button "1.1"}}
+} [list 1 [createPlatformMsg "1.1"]]
test msgbox-1.7 {tk_messageBox command} {
list [catch {tk_messageBox -default foo} msg] $msg
-} {1 {invalid default button "foo"}}
+} [list 1 [createPlatformMsg "foo"]]
test msgbox-1.8 {tk_messageBox command} {
list [catch {tk_messageBox -type yesno -default 3} msg] $msg
-} {1 {invalid default button "3"}}
+} [list 1 [createPlatformMsg "3"]]
test msgbox-1.9 {tk_messageBox command} {
list [catch {tk_messageBox -icon foo} msg] $msg
-} {1 {invalid icon "foo", must be error, info, question or warning}}
+} {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
@@ -66,14 +78,6 @@ if {[info commands tkMessageBox] == ""} {
set isNative 0
}
-if {$isNative && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test"
- return
-}
-
proc ChooseMsg {parent btn} {
global isNative
if {!$isNative} {
@@ -128,30 +132,57 @@ set specs {
# 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.1 {tk_messageBox command} {
+ 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.2 {tk_messageBox command -icon option} {
+ 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.3 {tk_messageBox command} {
+ 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/tk/tests/obj.test b/tk/tests/obj.test
index 1e3c52490c8..8edf93bc826 100644
--- a/tk/tests/obj.test
+++ b/tk/tests/obj.test
@@ -2,14 +2,13 @@
# 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.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) obj.test 1.2 97/11/17 11:20:18
+# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -34,4 +33,20 @@ test obj-4.1 {SetPixelFromAny} {
eval destroy [winfo children .]
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/oldpack.test b/tk/tests/oldpack.test
index 0d2f9ccf292..7676da2410d 100644
--- a/tk/tests/oldpack.test
+++ b/tk/tests/oldpack.test
@@ -4,14 +4,14 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# First, test a single window packed in various ways in a parent
@@ -505,4 +505,20 @@ test pack-9.3 {information output} {
} {{.pack.blue .pack.red .pack.green .pack.violet} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}}
catch {destroy .pack}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/option.test b/tk/tests/option.test
index 42c4d3bc980..aaa55ed0ea6 100644
--- a/tk/tests/option.test
+++ b/tk/tests/option.test
@@ -3,14 +3,14 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {destroy .op1}
catch {destroy .op2}
@@ -185,15 +185,9 @@ test option-14.12 {error conditions} {
list [catch {option get .gorp.gorp a A} msg] $msg
} {1 {bad window path name ".gorp.gorp"}}
-if {$tcl_platform(os) == "Win32s"} {
- set option1 OPTION~2.FIL
- set option2 OPTION~1.FIL
- set option3 OPTION~3.FIL
-} else {
- set option1 option.file1
- set option2 option.file2
- set option3 option.file3
-}
+set option1 [file join $::tcltest::testsDir option.file1]
+set option2 [file join $::tcltest::testsDir option.file2]
+set option3 [file join $::tcltest::testsDir option.file3]
test option-15.1 {database files} {
list [catch {option read non-existent} msg] $msg
@@ -229,4 +223,20 @@ test option-16.1 {ReadOptionFile} {
catch {destroy .op1}
catch {destroy .op2}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/pack.test b/tk/tests/pack.test
index e4f604ef062..c325b7d4c2d 100644
--- a/tk/tests/pack.test
+++ b/tk/tests/pack.test
@@ -3,14 +3,14 @@
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Utility procedures:
@@ -924,6 +924,13 @@ test pack-17.1 {PackLostSlaveProc procedure} {
} {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?
@@ -945,6 +952,12 @@ test pack-18.1 {unmap slaves when master unmapped} {tempNotPc} {
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
@@ -967,3 +980,20 @@ destroy .pack
foreach i {pack1 pack2 pack3 pack4} {
rename $i {}
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/place.test b/tk/tests/place.test
index f84903fc097..0d5722bdd21 100644
--- a/tk/tests/place.test
+++ b/tk/tests/place.test
@@ -2,14 +2,13 @@
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -218,4 +217,20 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} {
} {1 0 42 32 0 1}
catch {destroy .t}
-concat
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/raise.test b/tk/tests/raise.test
index e315db69839..b0017ba99e5 100644
--- a/tk/tests/raise.test
+++ b/tk/tests/raise.test
@@ -5,22 +5,23 @@
#
# Copyright (c) 1993-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {[info commands testmakeexist] == {}} {
puts "This application hasn't been compiled with the \"testmakeexist\""
puts "command, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
-
# Procedure to create a bunch of overlapping windows, which should
# make it easy to detect differences in order.
@@ -297,3 +298,20 @@ test raise-7.8 {errors in raise/lower commands} {
foreach i [winfo child .] {
destroy $i
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/safe.test b/tk/tests/safe.test
index 6b4cbee3b9f..508bf58e19a 100644
--- a/tk/tests/safe.test
+++ b/tk/tests/safe.test
@@ -3,14 +3,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -20,11 +19,11 @@ foreach i [winfo children .] {
# The set of hidden commands is platform dependent:
if {"$tcl_platform(platform)" == "macintosh"} {
- set hidden_cmds {beep bell cd clipboard echo exit fconfigure file glob grab load ls menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+ set hidden_cmds {beep bell cd clipboard echo encoding exit fconfigure file glob grab load ls menu open pwd selection send socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile toplevel wm}
} elseif {"$tcl_platform(platform)" == "windows"} {
- set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+ set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} else {
- set hidden_cmds {bell cd clipboard exec exit fconfigure file glob grab load menu open pwd selection send socket source tk tk_chooseColor tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+ set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk toplevel wm}
}
test safe-1.1 {Safe Tk loading into an interpreter} {
@@ -49,7 +48,7 @@ test safe-1.3 {Safe Tk loading into an interpreter} {
set l [lsort [interp aliases a]]
safe::interpDelete a
set l
-} {exit file load source}
+} {encoding exit file load source}
test safe-2.1 {Unsafe commands not available} {
catch {safe::interpDelete a}
@@ -102,9 +101,9 @@ test safe-4.1 {testing loadTk} {
# eventually see a new toplevel
set i [safe::loadTk [safe::interpCreate]]
interp eval $i {button .b -text "hello world!"; pack .b}
-# lets don't update because it might impy that the user has
-# to position the window (if the wm does not do it automatically)
-# and thus make the test suite not runable non interactively
+ # 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
} {}
@@ -166,4 +165,27 @@ test safe-6.2 {loadTk -use windowPath, conflicting -display} {
} {conflicting -display :23.56 and -use }
+test safe-7.1 {canvas printing} {
+ set i [safe::loadTk [safe::interpCreate]]
+ set r [catch {interp eval $i {canvas .c; .c postscript}}]
+ safe::interpDelete $i
+ set r
+} 0
+
+# cleanup
unset hidden_cmds
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/scale.test b/tk/tests/scale.test
index d4050f582e0..73d21846785 100644
--- a/tk/tests/scale.test
+++ b/tk/tests/scale.test
@@ -3,14 +3,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -56,19 +55,19 @@ foreach test {
{-label "Some text" {Some text} {} {}}
{-length 130 130 badValue {bad screen distance "badValue"}}
{-orient horizontal horizontal badValue
- {bad orientation "badValue": must be vertical or horizontal}}
+ {bad orient "badValue": must be horizontal or vertical}}
{-orient horizontal horizontal {} {}}
- {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-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 type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
- {-state disabled disabled badValue
- {bad state value "badValue": must be normal, active, or disabled}}
- {-state normal normal {} {}}
+ {-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"}}
@@ -93,8 +92,8 @@ foreach test {
.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?"}}
@@ -124,8 +123,8 @@ test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
.s cget -highlightthickness
} {2}
test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
- list [llength [.s configure]] [lindex [.s configure] 5]
-} {33 {-borderwidth borderWidth BorderWidth 2 2}}
+ 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"}}
@@ -212,10 +211,10 @@ test scale-3.29 {ScaleWidgetCmd procedure} {
} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
test scale-3.30 {ScaleWidgetCmd procedure} {
list [catch {.s c} msg] $msg
-} {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
+} {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 {bad option "co": must be cget, configure, coords, get, identify, or set}}
+} {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
@@ -270,7 +269,7 @@ test scale-5.4 {ConfigureScale procedure} {
catch {destroy .s}
scale .s -from 0 -to 100
list [catch {.s configure -orient dumb} msg] $msg
-} {1 {bad orientation "dumb": must be vertical or horizontal}}
+} {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
@@ -288,7 +287,7 @@ test scale-5.6 {ConfigureScale procedure} {
test scale-5.7 {ConfigureScale procedure} {
catch {destroy .s}
list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
-} {1 {bad state value "bogus": must be normal, active, or disabled}}
+} {1 {bad state "bogus": must be active, disabled, or normal}}
catch {destroy .s}
scale .s -orient horizontal -length 200
@@ -360,7 +359,7 @@ test scale-6.13 {ComputeFormat procedure} {
.s configure -from .000001 -to .00001 -resolution .000001
.s set .000006
expr {[.s get] == 6.0e-06}
-} 1
+} {1}
test scale-6.14 {ComputeFormat procedure} {
.s configure -to .00001 -from .0001 -resolution .00001
.s set .00006
@@ -370,12 +369,12 @@ test scale-6.15 {ComputeFormat procedure} {
.s configure -to .000001 -from .00001 -resolution .000001
.s set .000006
expr {[.s get] == 6.0e-06}
-} 1
+} {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
+} {1}
test scale-6.17 {ComputeFormat procedure} {
.s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
.s set 49300000
@@ -397,7 +396,7 @@ test scale-6.20 {ComputeFormat procedure} {
.s get
} {1001.235}
-test scale-7.1 {ComputeScaleGeometry procedure} {fonts} {
+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
@@ -427,7 +426,7 @@ test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
update
list [winfo reqwidth .s] [winfo reqheight .s]
} {39 114}
-test scale-7.5 {ComputeScaleGeometry procedure} {fonts} {
+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
@@ -797,5 +796,34 @@ test scale-16.1 {scale widget vs hidden commands} {
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/tk/tests/scrollbar.test b/tk/tests/scrollbar.test
index 43709c74ac1..025375fdf0d 100644
--- a/tk/tests/scrollbar.test
+++ b/tk/tests/scrollbar.test
@@ -4,14 +4,22 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+## testmetrics is a win/mac only test command
+##
+if {[string compare unix $tcl_platform(platform)] && \
+ [string equal {} [info commands testmetrics]]} {
+ puts "\"testmetrics\" isn't defined, skipping scrollbar tests"
+ ::tcltest::cleanupTests
+ return
}
foreach i [winfo children .] {
@@ -37,14 +45,14 @@ proc getTroughSize {w} {
} else {
if [string match v* [$w cget -orient]] {
return [expr [winfo height $w] \
- - ([winfo width $w] \
- - [$w cget -highlightthickness] \
- - [$w cget -bd] + 1)*2]
+ - ([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]
+ - ([winfo height $w] \
+ - [$w cget -highlightthickness] \
+ - [$w cget -bd] + 1)*2]
}
}
}
@@ -90,7 +98,7 @@ foreach test {
{-repeatdelay 140 140 129.3 {expected integer but got "129.3"}}
{-repeatinterval 140 140 129.3 {expected integer but got "129.3"}}
{-takefocus "any string" "any string" {} {}}
- {-trough #432 #432 lousy {unknown color name "lousy"}}
+ {-troughcolor #432 #432 lousy {unknown color name "lousy"}}
{-width 32 32 badValue {bad screen distance "badValue"}}
} {
set name [lindex $test 0]
@@ -170,16 +178,16 @@ test scrollbar-3.10 {ScrollbarWidgetCmd procedure, "cget" option} {
list [catch {.s cget -orient} msg] $msg
} {0 vertical}
scrollbar .s2
-test scrollbar-3.11 {ScrollbarWidgetCmd procedure, "cget" option} {pc} {
+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} {!pc} {
+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} {pc} {
+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} {!pc} {
+test scrollbar-3.14 {ScrollbarWidgetCmd procedure, "cget" option} {macOrUnix} {
list [catch {.s2 cget -highlightthickness} msg] $msg
} {0 1}
destroy .s2
@@ -626,6 +634,7 @@ test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} {
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 {}
@@ -643,6 +652,7 @@ test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} {
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 {}
@@ -662,4 +672,20 @@ test scrollbar-9.1 {scrollbar widget vs hidden commands} {
catch {destroy .s}
catch {destroy .t}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/select.test b/tk/tests/select.test
index 1ebaad629bc..1ea604c9d76 100644
--- a/tk/tests/select.test
+++ b/tk/tests/select.test
@@ -3,9 +3,8 @@
# fashion for Tcl tests.
#
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
@@ -14,8 +13,8 @@
# environment variable TK_ALT_DISPLAY is set to an alternate display.
#
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
eval destroy [winfo child .]
@@ -449,10 +448,10 @@ test select-5.10 {Tk_GetSelection procedure} {unixOnly} {
set selInfo ""
selection own .f1
set result ""
- fileevent $fd readable {}
- puts $fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
- flush $fd
- lappend result [gets $fd]
+ fileevent $::tcltest::fd readable {}
+ puts $::tcltest::fd {catch {selection get TEST} msg; update; puts $msg; flush stdout}
+ flush $::tcltest::fd
+ lappend result [gets $::tcltest::fd]
cleanupbg
lappend result $selInfo
} {{selection owner didn't respond} {}}
@@ -814,14 +813,14 @@ test select-10.1 {ConvertSelection procedure, race with selection clear} {unixOn
set selInfo ""
selection handle .f1 {handler STRING}
update
- puts $fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout}
- flush $fd
+ puts $::tcltest::fd {puts "[catch {selection get} msg] $msg"; puts **DONE**; flush stdout}
+ flush $::tcltest::fd
after 200
selection own .
- set bgData {}
- tkwait variable bgDone
+ set ::tcltest::bgData {}
+ tkwait variable ::tcltest::bgDone
cleanupbg
- list $bgData $selInfo
+ list $::tcltest::bgData $selInfo
} {{1 PRIMARY selection doesn't exist or form "STRING" not defined} {}}
test select-10.2 {ConvertSelection procedure} {unixOnly} {
setup
@@ -844,7 +843,8 @@ test select-10.3 {ConvertSelection procedure} {unixOnly} {
set result
} {{PRIMARY selection doesn't exist or form "ERROR" not defined}}
# testing timers
-test select-10.4 {ConvertSelection procedure} {unixOnly} {
+# This one hangs in Exceed
+test select-10.4 {ConvertSelection procedure} {unixOnly noExceed} {
setup
setupbg
set selValue $longValue
@@ -984,4 +984,20 @@ test select-13.1 {SelectionSize procedure, handler deleted} {unixOnly} {
} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000 .f1 STRING 4000 4000}}
catch {rename weirdHandler {}}
-concat
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/send.test b/tk/tests/send.test
index 427cd972d86..30a7940469b 100644
--- a/tk/tests/send.test
+++ b/tk/tests/send.test
@@ -4,28 +4,31 @@
#
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {$tcl_platform(platform) == "macintosh"} {
puts "send is not available on the Mac - skipping tests"
+ ::tcltest::cleanupTests
return
}
if {$tcl_platform(platform) == "window"} {
puts "send is not available under Windows - skipping tests"
+ ::tcltest::cleanupTests
return
}
if {[auto_execok xhost] == ""} {
puts "xhost application isn't available - skipping tests"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
if {[info commands testsend] == "testsend"} {
set gotTestCmds 1
} else {
@@ -48,6 +51,7 @@ if {[catch {send $app set a 0} msg] == 1} {
puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
puts " skipping \"send\" tests."
cleanupbg
+ ::tcltest::cleanupTests
return
}
}
@@ -325,6 +329,8 @@ if $gotTestCmds {
while executing
"open bogus_file_name"
invoked from within
+"if 1 {open bogus_file_name}"
+ invoked from within
"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
test send-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
testsend prop root InterpRegistry "10234 bogus\n"
@@ -546,7 +552,7 @@ r
setupbg
dobg {tk appname t_s_3}
set x [list [catch {send t_s_3 exit} msg] $msg]
- close $fd
+ close $::tcltest::fd
set x
} {1 {target application died}}
@@ -577,15 +583,15 @@ test send-12.2 {TimeoutProc procedure} {
tk appname tktest
update
setupbg
- puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
- set bgDone 0
- set bgData {}
- flush $fd
- tkwait variable bgDone
- set app $bgData
+ puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
+ set ::tcltest::bgDone 0
+ set ::tcltest::bgData {}
+ flush $::tcltest::fd
+ tkwait variable ::tcltest::bgDone
+ set app $::tcltest::bgData
after 200
set result [list [catch {send $app foo} msg] $msg]
- close $fd
+ close $::tcltest::fd
set result
} {1 {target application died}}
@@ -654,3 +660,20 @@ if $gotTestCmds {
testdeleteapps
}
rename newApp {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/text.test b/tk/tests/text.test
index 533fd4e9ad3..e002c7e43b5 100644
--- a/tk/tests/text.test
+++ b/tk/tests/text.test
@@ -3,14 +3,14 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
eval destroy [winfo child .]
@@ -81,10 +81,10 @@ foreach test {
{-spacing2 -1 0 bogus}
{-spacing3 20 20 bogus}
{-spacing3 -10 0 bogus}
- {-state disabled disabled foo}
+ {-state d disabled foo}
{-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
{-width 73 73 2.4}
- {-wrap word word bad_wrap}
+ {-wrap w word bad_wrap}
} {
test text-1.[incr i] {text options} {
set result {}
@@ -150,7 +150,7 @@ test text-3.1 {TextWidgetCmd procedure, basics} {
} {1 {wrong # args: should be ".t option ?arg arg ...?"}}
test text-3.2 {TextWidgetCmd procedure} {
list [catch {.t gorp 1.0 z 1.2} msg] $msg
-} {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, 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
@@ -218,7 +218,7 @@ test text-6.13 {TextWidgetCmd procedure, "compare" option} {
} {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
test text-6.14 {TextWidgetCmd procedure, "compare" option} {
list [catch {.t co 1.0 z 1.2} msg] $msg
-} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
# "configure" option is already covered above
@@ -227,7 +227,7 @@ test text-7.1 {TextWidgetCmd procedure, "debug" option} {
} {1 {wrong # args: should be ".t debug boolean"}}
test text-7.2 {TextWidgetCmd procedure, "debug" option} {
list [catch {.t de 0 1} msg] $msg
-} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, 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
@@ -310,7 +310,7 @@ test text-10.2 {TextWidgetCmd procedure, "index" option} {
} {1 {wrong # args: should be ".t index index"}}
test text-10.3 {TextWidgetCmd procedure, "index" option} {
list [catch {.t in a b} msg] $msg
-} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, dump, 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"}}
@@ -854,7 +854,7 @@ test text-19.3 {TkTextLostSelection procedure} {
.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
test text-20.1 {TextSearchCmd procedure, argument parsing} {
list [catch {.t search -} msg] $msg
-} {1 {bad switch "-": must be -forward, -backward, -exact, -regexp, -nocase, -count, or --}}
+} {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}
@@ -885,10 +885,10 @@ test text-20.10 {TextSearchCmd procedure, -- option} {
} {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?}}
+} {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?}}
+} {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"}}
@@ -906,7 +906,7 @@ test text-20.17 {TextSearchCmd procedure, pattern case conversion} {
} {2.13 {}}
test text-20.18 {TextSearchCmd procedure, bad regular expression pattern} {
list [catch {.t search -regexp a( 1.0} msg] $msg
-} {1 {couldn't compile regular expression pattern: unmatched ()}}
+} {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}
@@ -961,6 +961,13 @@ test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
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"
+ tkTextSetCursor .t 4.0
+ .t search -forward -regexp {^$} insert end
+} {4.0}
+
catch {destroy .t2}
toplevel .t2
wm geometry .t2 +0+0
@@ -1082,7 +1089,81 @@ test text-20.62 {TextSearchCmd, freeing copy of pattern} {
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} {
+ eval destroy [winfo child .]
+ 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} {
+ eval destroy [winfo child .]
+ 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} {
+ eval destroy [winfo child .]
+ 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} {
+ eval destroy [winfo child .]
+ 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
+
eval destroy [winfo child .]
text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100
pack .t2
@@ -1246,6 +1327,20 @@ test text-22.24 {TextDumpCmd procedure, command script} {
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]
eval destroy [winfo children .]
@@ -1258,5 +1353,36 @@ test text-23.1 {text widget vs hidden commands} {
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"
+ tkTextSetCursor .t 3.0
+ .t search -backward -regexp "\$" insert 1.0
+} {2.6}
+
eval destroy [winfo child .]
option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/textBTree.test b/tk/tests/textBTree.test
index 415ed5c3b9f..a59960d555b 100644
--- a/tk/tests/textBTree.test
+++ b/tk/tests/textBTree.test
@@ -5,14 +5,14 @@
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {destroy .t}
text .t
@@ -893,5 +893,21 @@ test btree-18.9 {tag search back, large complex btree spans} {
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/tk/tests/textDisp.test b/tk/tests/textDisp.test
index d6b460f46a3..95d3e90ff29 100644
--- a/tk/tests/textDisp.test
+++ b/tk/tests/textDisp.test
@@ -3,17 +3,16 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} {
- source defs
- if {$testConfig(fonts) == 0} {
- puts "skipping font-sensitive tests"
- }
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+if {$::tcltest::testConfig(fonts) == 0} {
+ puts "skipping font-sensitive tests"
}
# The procedure below is used as the scrolling command for the text;
@@ -1794,10 +1793,10 @@ 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 configure -wrap none
test textDisp-17.1 {TkTextScanCmd procedure} {
list [catch {.t scan a b} msg] $msg
-} {1 {wrong # args: should be ".t scan mark|dragto x y"}}
+} {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 {wrong # args: should be ".t scan mark|dragto x y"}}
+} {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"}}
@@ -2866,3 +2865,20 @@ foreach i [winfo children .] {
catch {destroy $i}
}
option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/textImage.test b/tk/tests/textImage.test
index 4734711a55c..7bc8e4b3557 100644
--- a/tk/tests/textImage.test
+++ b/tk/tests/textImage.test
@@ -1,7 +1,17 @@
+# 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$
-if {[string compare test [info procs test]] == 1} then \
- {source ../tests/defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Test Arguments:
# name - Name of test, in the form foo-1.2.
@@ -9,7 +19,7 @@ if {[string compare test [info procs test]] == 1} then \
# help humans understand what it does.
# constraints - A list of one or more keywords, each of
# which must be the name of an element in
-# the array "testConfig". If any of these
+# the array "::tcltest::testConfig". If any of these
# elements is zero, the test is skipped.
# This argument may be omitted.
# script - Script to run to carry out the test. It must
@@ -351,3 +361,20 @@ test textImage-4.3 {alignment and padding checking} {fonts} {
catch {destroy .t}
foreach image [image names] {image delete $image}
font delete test_font
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/textIndex.test b/tk/tests/textIndex.test
index dce76a1b50d..67b9ba816c1 100644
--- a/tk/tests/textIndex.test
+++ b/tk/tests/textIndex.test
@@ -3,21 +3,22 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# Some tests require the testtext command
+
+set ::tcltest::testConfig(testtext) \
+ [expr {[info commands testtext] != {}}]
catch {destroy .t}
-if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
- puts "The font needed by these tests isn't available, so I'm"
- puts "going to skip the tests."
- return
-}
+text .t -font {Courier -12} -width 20 -height 10
pack append . .t {top expand fill}
update
.t debug on
@@ -35,73 +36,181 @@ wm deiconify .
abcdefghijklm
12345
Line 4
-bOy GIrl .#@? x_yz
+b\u4e4fy GIrl .#@? x_yz
!@#$%
Line 7"
-test textIndex-1.1 {TkTextMakeIndex} {
+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-1.2 {TkTextMakeIndex} {
+test textIndex-2.2 {TkTextMakeCharIndex} {
+ # (lineIndex < 0), because lineIndex == strtol(argv[2]) - 1
.t index 0.3
} 1.0
-test textIndex-1.3 {TkTextMakeIndex} {
+test textIndex-2.3 {TkTextMakeCharIndex} {
+ # not (lineIndex < 0)
.t index 1.3
} 1.3
-test textIndex-1.4 {TkTextMakeIndex} {
+test textIndex-2.4 {TkTextMakeCharIndex} {
+ # (charIndex < 0)
.t index 3.-1
} 3.0
-test textIndex-1.5 {TkTextMakeIndex} {
+test textIndex-2.5 {TkTextMakeCharIndex} {
+ # (charIndex < 0)
.t index 3.3
} 3.3
-test textIndex-1.6 {TkTextMakeIndex} {
+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-1.7 {TkTextMakeIndex} {
- .t index 3.6
+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-1.8 {TkTextMakeIndex} {
+test textIndex-2.10 {TkTextMakeCharIndex: verify index is in range} {
+ # (segPtr == NULL)
.t index 3.7
} 3.5
-test textIndex-1.9 {TkTextMakeIndex} {
- .t index 7.2
-} 7.2
-test textIndex-1.10 {TkTextMakeIndex} {
- .t index 8.0
-} 8.0
-test textIndex-1.11 {TkTextMakeIndex} {
- .t index 8.1
-} 8.0
-test textIndex-1.12 {TkTextMakeIndex} {
- .t index 9.0
-} 8.0
+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 tag add x 2.3 2.6
-test textIndex-2.1 {TkTextIndexToSeg} {
- .t get 2.0
-} a
-test textIndex-2.2 {TkTextIndexToSeg} {
- .t get 2.2
-} c
-test textIndex-2.3 {TkTextIndexToSeg} {
- .t get 2.3
-} d
-test textIndex-2.4 {TkTextIndexToSeg} {
- .t get 2.6
-} g
-test textIndex-2.5 {TkTextIndexToSeg} {
- .t get 2.7
-} h
-test textIndex-2.6 {TkTextIndexToSeg} {
- .t get 2.12
-} m
-test textIndex-2.7 {TkTextIndexToSeg} {
- .t get 2.13
-} \n
-test textIndex-2.8 {TkTextIndexToSeg} {
- .t get 2.14
-} \n
-.t tag delete x
+ .t 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
@@ -143,7 +252,7 @@ test textIndex-4.8 {TkTextGetIndex, tags} {
set result
} {1.0 1.1}
-test textIndex-5.1 {TkTextGetIndex, "@"} {fonts} {
+test textIndex-5.1 {TkTextGetIndex, "@"} {nonPortable fonts} {
.t index @12,9
} 1.1
test textIndex-5.2 {TkTextGetIndex, "@"} {fonts} {
@@ -242,8 +351,8 @@ test textIndex-10.4 {ForwBack} {
list [catch {.t index {2.3 - 3ch}} msg] $msg
} {0 2.0}
test textIndex-10.5 {ForwBack} {
- list [catch {.t index {2.3 + 3 lines}} msg] $msg
-} {0 5.3}
+ 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}
@@ -253,97 +362,325 @@ test textIndex-10.7 {ForwBack} {
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 {TkTextIndexForwChars} {
+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-11.2 {TkTextIndexForwChars} {
+test textIndex-12.2 {TkTextIndexForwChars} {
+ # not (charCount < 0)
.t index {2.3 + 5 chars}
} 2.8
-test textIndex-11.3 {TkTextIndexForwChars} {
+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-11.4 {TkTextIndexForwChars} {
+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-11.5 {TkTextIndexForwChars} {
- .t index {2.3 + 55 chars}
-} 7.6
-test textIndex-11.6 {TkTextIndexForwChars} {
+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-11.7 {TkTextIndexForwChars} {
+test textIndex-12.14 {TkTextIndexForwChars} {
+ # try to go past end
.t index {2.3 + 57 chars}
} 8.0
-test textIndex-12.1 {TkTextIndexBackChars} {
+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-12.2 {TkTextIndexBackChars} {
+test textIndex-14.2 {TkTextIndexBackChars} {
+ # not (charCount < 0)
.t index {3.2 - 2 chars}
} 3.0
-test textIndex-12.3 {TkTextIndexBackChars} {
+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-12.4 {TkTextIndexBackChars} {
+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-12.5 {TkTextIndexBackChars} {
- .t index {3.2 - 23 chars}
-} 1.0
-test textIndex-12.6 {TkTextIndexBackChars} {
- .t index {3.2 - 24 chars}
+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-13.1 {StartEnd} {
+test textIndex-15.1 {StartEnd} {
list [catch {.t index {2.3 lineend}} msg] $msg
} {0 2.13}
-test textIndex-13.2 {StartEnd} {
+test textIndex-15.2 {StartEnd} {
list [catch {.t index {2.3 linee}} msg] $msg
} {0 2.13}
-test textIndex-13.3 {StartEnd} {
+test textIndex-15.3 {StartEnd} {
list [catch {.t index {2.3 line}} msg] $msg
} {1 {bad text index "2.3 line"}}
-test textIndex-13.4 {StartEnd} {
+test textIndex-15.4 {StartEnd} {
list [catch {.t index {2.3 linestart}} msg] $msg
} {0 2.0}
-test textIndex-13.5 {StartEnd} {
+test textIndex-15.5 {StartEnd} {
list [catch {.t index {2.3 lines}} msg] $msg
} {0 2.0}
-test textIndex-13.6 {StartEnd} {
+test textIndex-15.6 {StartEnd} {
getword 5.3
} { }
-test textIndex-13.7 {StartEnd} {
+test textIndex-15.7 {StartEnd} {
getword 5.4
} GIrl
-test textIndex-13.8 {StartEnd} {
+test textIndex-15.8 {StartEnd} {
getword 5.7
} GIrl
-test textIndex-13.9 {StartEnd} {
+test textIndex-15.9 {StartEnd} {
getword 5.8
} { }
-test textIndex-13.10 {StartEnd} {
+test textIndex-15.10 {StartEnd} {
getword 5.14
} x_yz
-test textIndex-13.11 {StartEnd} {
+test textIndex-15.11 {StartEnd} {
getword 6.2
} #
-test textIndex-13.12 {StartEnd} {
+test textIndex-15.12 {StartEnd} {
getword 3.4
} 12345
.t tag add x 2.8 2.11
-test textIndex-13.13 {StartEnd} {
+test textIndex-15.13 {StartEnd} {
list [catch {.t index {2.2 worde}} msg] $msg
} {0 2.13}
-test textIndex-13.14 {StartEnd} {
+test textIndex-15.14 {StartEnd} {
list [catch {.t index {2.12 words}} msg] $msg
} {0 2.0}
-test textIndex-13.15 {StartEnd} {
+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}
-concat
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/textMark.test b/tk/tests/textMark.test
index 9680a98c5c7..02f1208091c 100644
--- a/tk/tests/textMark.test
+++ b/tk/tests/textMark.test
@@ -3,19 +3,20 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
puts "The font needed by these tests isn't available, so I'm"
puts "going to skip the tests."
+ ::tcltest::cleanupTests
return
}
pack append . .t {top expand fill}
@@ -219,4 +220,20 @@ test textMark-8.8 {MarkFindPrev - no previous mark} {
} {}
catch {destroy .t}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/textTag.test b/tk/tests/textTag.test
index dee46079fef..ed642da6b87 100644
--- a/tk/tests/textTag.test
+++ b/tk/tests/textTag.test
@@ -3,19 +3,20 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {destroy .t}
if [catch {text .t -font {Courier 12} -width 20 -height 10}] {
puts "The font needed by these tests isn't available, so I'm"
puts "going to skip the tests."
+ ::tcltest::cleanupTests
return
}
pack append . .t {top expand fill}
@@ -183,7 +184,14 @@ test textTag-3.7 {TkTextTagCmd - "bind" option} {
.t tag bind x <Enter>
} {script1
script2}
-
+test textTag-3.7 {TkTextTagCmd - "bind" option} {
+ .t tag delete x
+ list [catch {.t tag bind x <Enter>} msg] $msg
+} {0 {}}
+test textTag-3.8 {TkTextTagCmd - "bind" option} {
+ .t tag delete x
+ list [catch {.t tag bind x <} msg] $msg
+} {1 {no event type or button # or keysym}}
test textTag-4.1 {TkTextTagCmd - "cget" option} {
list [catch {.t tag cget a} msg] $msg
@@ -587,10 +595,13 @@ test textTag-15.1 {TkTextBindProc} {
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> {}
@@ -753,4 +764,20 @@ test textTag-16.7 {TkTextPickCurrent procedure} {
} {3.1}
catch {destroy .t}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/textWind.test b/tk/tests/textWind.test
index f75c66c2a6f..85a959b6bd4 100644
--- a/tk/tests/textWind.test
+++ b/tk/tests/textWind.test
@@ -3,14 +3,14 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
foreach i [winfo child .] {
catch {destroy $i}
@@ -824,3 +824,20 @@ pack .t
catch {destroy .t}
option clear
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/tk.test b/tk/tests/tk.test
index 408ce7173cf..0d0ec2b9839 100644
--- a/tk/tests/tk.test
+++ b/tk/tests/tk.test
@@ -2,14 +2,13 @@
# It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info commands test] == ""} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
test tk-1.1 {tk command: general} {
@@ -17,7 +16,7 @@ test tk-1.1 {tk command: general} {
} {1 {wrong # args: should be "tk option ?arg?"}}
test tk-1.2 {tk command: general} {
list [catch {tk xyz} msg] $msg
-} {1 {bad option "xyz": must be appname, or scaling}}
+} {1 {bad option "xyz": must be appname, scaling, or useinputmethods}}
set appname [tk appname]
test tk-2.1 {tk command: appname} {
@@ -34,7 +33,7 @@ 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
@@ -78,3 +77,40 @@ test tk-3.11 {tk command: scaling: heightmm} {
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"
+ }
+ # We should always start with XIM support off
+ set useim
+} 0
+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
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tk/tests/unixButton.test b/tk/tests/unixButton.test
index 1ee15affafd..087b7d1a1cc 100644
--- a/tk/tests/unixButton.test
+++ b/tk/tests/unixButton.test
@@ -5,13 +5,18 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {$tcl_platform(platform)!="unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
return
}
@@ -19,13 +24,10 @@ if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\""
puts "image, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -180,3 +182,20 @@ test unixbutton-1.11 {TkpComputeButtonGeometry procedure} {
} {27 37}
eval destroy [winfo children .]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/unixEmbed.test b/tk/tests/unixEmbed.test
index 824c8833828..54d548a4cda 100644
--- a/tk/tests/unixEmbed.test
+++ b/tk/tests/unixEmbed.test
@@ -3,18 +3,19 @@
# tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-if {[info procs test] != "test"} {
- source defs
+if {$tcl_platform(platform) != "unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
}
eval destroy [winfo children .]
@@ -72,7 +73,7 @@ test unixEmbed-1.2 {TkpUseWindow procedure, bad window identifier} {
catch {destroy .t}
list [catch {toplevel .t -use 47} msg] $msg
} {1 {couldn't create child of window "47"}}
-test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {
+test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {nonPortable} {
catch {destroy .t}
catch {destroy .x}
toplevel .t -colormap new
@@ -84,7 +85,7 @@ test unixEmbed-1.3 {TkpUseWindow procedure, inheriting colormap} {
destroy .t
set result
} {0}
-test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {
+test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {nonPortable} {
catch {destroy .t}
catch {destroy .t2}
catch {destroy .x}
@@ -100,6 +101,8 @@ test unixEmbed-1.4 {TkpUseWindow procedure, inheriting colormap} {
if {[string compare testembed [info commands testembed]] != 0} {
puts "This application hasn't been compiled with the testembed command,"
puts "therefore I am skipping all of these tests."
+ cleanupbg
+ ::tcltest::cleanupTests
return
}
@@ -200,7 +203,8 @@ test unixEmbed-2.4 {EmbeddedEventProc procedure} {
list $x [testembed]
} {{{XXX .f1 {} {}}} {}}
-test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} {
+test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} \
+ {nonPortable} {
foreach w [winfo child .] {
catch {destroy $w}
}
@@ -620,8 +624,23 @@ test unixEmbed-10.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {
wm geometry .t1
} {70x300+0+0}
-
+# cleanup
foreach w [winfo child .] {
catch {destroy $w}
}
cleanupbg
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/unixFont.test b/tk/tests/unixFont.test
index 7df571a69a4..b39697a9a79 100644
--- a/tk/tests/unixFont.test
+++ b/tk/tests/unixFont.test
@@ -9,18 +9,19 @@
# at all sites.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform)!="unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-if {[string compare test [info procs test]] != 0} {
- source defs
+if {$tcl_platform(platform)!="unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
}
catch {destroy .b}
@@ -49,7 +50,7 @@ proc getsize {} {
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}
-test unixfont-1.1 {TkpGetNativeFont procedure: not native} {
+test unixfont-1.1 {TkpGetNativeFont procedure: not native} {noExceed} {
list [catch {font measure {} xyz} msg] $msg
} {1 {font "" doesn't exist}}
test unixfont-1.2 {TkpGetNativeFont procedure: native} {
@@ -60,19 +61,22 @@ test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
font actual {-size 10}
set x {}
} {}
-test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} {
+test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} \
+ {noExceed} {
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} {
+test unixfont-2.3 {TkpGetFontFromAttributes procedure: Courier relatives} \
+ {noExceed} {
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} {
+test unixfont-2.4 {TkpGetFontFromAttributes procedure: Helvetica relatives} \
+ {noExceed} {
set x {}
lappend x [lindex [font actual {-family "Arial"}] 1]
lappend x [lindex [font actual {-family "Geneva"}] 1]
@@ -91,7 +95,7 @@ test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} {
test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} {
lindex [font actual {-family fixed -size 31}] 1
} {fixed}
-test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {
+test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {noExceed} {
lindex [font actual {-family courier}] 1
} {courier}
test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} {
@@ -222,23 +226,25 @@ test unixfont-8.1 {AllocFont procedure: use old font} {
font delete xyz
} {}
test unixfont-8.2 {AllocFont procedure: parse information from XLFD} {
- expr [lindex [font actual {-family times -size 0}] 3]==0
+ expr {[lindex [font actual {-family times -size 0}] 3] == 0}
} {0}
test unixfont-8.3 {AllocFont procedure: can't parse info from name} {
- if [catch {set a [font actual a12biluc]}]==0 {
- string compare $a "-family a12biluc -size 0 -weight normal -slant roman -underline 0 -overstrike 0"
- } else {
- set a 0
- }
-} {0}
+ catch {unset fontArray}
+ # check that font actual returns the correct attributes.
+ # the values of those attributes are system dependent.
+ array set fontArray [font actual a12biluc]
+ set result [lsort [array names fontArray]]
+ catch {unset fontArray}
+ set result
+} {-family -overstrike -size -slant -underline -weight}
test unixfont-8.4 {AllocFont procedure: classify characters} {
set x 0
- incr x [font measure $courier "\001"] ;# 4
+ 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*11]
+} [expr $cx*13]
test unixfont-8.5 {AllocFont procedure: setup widths of normal chars} {
font metrics $courier -fixed
} {1}
@@ -281,7 +287,7 @@ test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {
} {0 1 1 2}
test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
.b.c dchars $t 0 end
- .b.c insert $t 0 "0\1770"
+ .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]
@@ -291,3 +297,19 @@ test unixfont-9.2 {GetControlCharSubst procedure: 4 chars subst} {
lappend x [.b.c index $t @[expr $ax*5],0]
} {0 1 1 1 1 2}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/unixMenu.test b/tk/tests/unixMenu.test
index ed4532d7851..f93e2a14402 100644
--- a/tk/tests/unixMenu.test
+++ b/tk/tests/unixMenu.test
@@ -4,13 +4,18 @@
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
if {$tcl_platform(platform) != "unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
return
}
@@ -18,13 +23,10 @@ if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
proc deleteWindows {} {
foreach i [winfo children .] {
catch [destroy $i]
@@ -332,8 +334,8 @@ test unixMenu-18.1 {GetTearoffEntryGeometry} {
.mb.m add command -label test
pack .mb
raise .
- list [catch {tkMbPost .mb} msg] $msg [destroy .mb]
-} {0 {} {}}
+ list [catch {tkMbPost .mb} msg] $msg [tkMenuUnpost .mb.m] [destroy .mb]
+} {0 {} {} {}}
# Don't know how to reproduce the case where the tkwin has been deleted.
test unixMenu-19.1 {TkpComputeMenubarGeometry - zero entries} {
@@ -848,8 +850,8 @@ test unixMenu-25.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
.mb.m add command -label test
pack .mb
catch {tkMbPost .mb}
- list [update] [destroy .mb]
-} {{} {}}
+ list [update] [tkMenuUnpost .mb.m] [destroy .mb]
+} {{} {} {}}
test unixMenu-25.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
catch {destroy .m1}
menu .m1
@@ -966,4 +968,7 @@ test unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} {
test unixMenu-26.1 {TkpMenuInit - nothing to do} {} {}
+# cleanup
deleteWindows
+::tcltest::cleanupTests
+return
diff --git a/tk/tests/unixSelect.test b/tk/tests/unixSelect.test
new file mode 100644
index 00000000000..9a29d0abcdc
--- /dev/null
+++ b/tk/tests/unixSelect.test
@@ -0,0 +1,244 @@
+# 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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) != "unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
+}
+
+eval destroy [winfo child .]
+
+global longValue selValue selInfo
+
+set selValue {}
+set selInfo {}
+
+proc handler {type offset count} {
+ global selValue selInfo
+ lappend selInfo $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+proc errIncrHandler {type offset count} {
+ global selValue selInfo pass
+ if {$offset == 4000} {
+ if {$pass == 0} {
+ # Just sizing the selection; don't do anything here.
+ set pass 1
+ } else {
+ # Fetching the selection; wait long enough to cause a timeout.
+ after 6000
+ }
+ }
+ lappend selInfo $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+proc errHandler args {
+ error "selection handler aborted"
+}
+
+proc badHandler {path type offset count} {
+ global selValue selInfo
+ selection handle -type $type $path {}
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+proc reallyBadHandler {path type offset count} {
+ global selValue selInfo pass
+ if {$offset == 4000} {
+ if {$pass == 0} {
+ set pass 1
+ } else {
+ selection handle -type $type $path {}
+ }
+ }
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+# Eliminate any existing selection on the screen. This is needed in case
+# there is a selection in some other application, in order to prevent races
+# from causing false errors in the tests below.
+
+selection clear .
+after 1500
+
+# common setup code
+proc setup {{path .f1} {display {}}} {
+ catch {destroy $path}
+ if {$display == {}} {
+ frame $path
+ } else {
+ toplevel $path -screen $display
+ wm geom $path +0+0
+ }
+ selection own $path
+}
+
+# set up a very large buffer to test INCR retrievals
+set longValue ""
+foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
+ set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
+ append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
+}
+
+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/tk/tests/unixSend.test b/tk/tests/unixSend.test
new file mode 100644
index 00000000000..0afdd4974d9
--- /dev/null
+++ b/tk/tests/unixSend.test
@@ -0,0 +1,679 @@
+# This file is a Tcl script to test out the "send" command and the
+# other procedures in the file tkSend.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) == "macintosh"} {
+ puts "send is not available on the Mac - skipping tests"
+ ::tcltest::cleanupTests
+ return
+}
+if {$tcl_platform(platform) == "windows"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
+}
+if {[auto_execok xhost] == ""} {
+ puts "xhost application isn't available - skipping tests"
+ ::tcltest::cleanupTests
+ return
+}
+
+if {[info commands testsend] == "testsend"} {
+ set gotTestCmds 1
+} else {
+ set gotTestCmds 0
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+# If send is disabled because of inadequate security, don't run any
+# of these tests at all.
+
+setupbg
+set app [dobg {tk appname}]
+if {[catch {send $app set a 0} msg] == 1} {
+ if [string match "X server insecure *" $msg] {
+ puts -nonewline "Your X server is insecure, so \"send\" can't be used;"
+ puts " skipping \"send\" tests."
+ cleanupbg
+ ::tcltest::cleanupTests
+ return
+ }
+}
+cleanupbg
+
+# Compute a script that will load Tk into a child interpreter.
+
+foreach pkg [info loaded] {
+ if {[lindex $pkg 1] == "Tk"} {
+ set loadTk "load $pkg"
+ break
+ }
+}
+
+# Procedure to create a new application with a given name and class.
+
+proc newApp {screen name class} {
+ global loadTk
+ interp create $name
+ $name eval [list set argv [list -display $screen -name $name -class $class]]
+ eval $loadTk $name
+}
+
+set name [tk appname]
+if $gotTestCmds {
+ set registry [testsend prop root InterpRegistry]
+ set commId [lindex [testsend prop root InterpRegistry] 0]
+}
+tk appname tktest
+catch {send t_s_1 destroy .}
+catch {send t_s_2 destroy .}
+
+if $gotTestCmds {
+ test unixSend-1.1 {RegOpen procedure, bogus property} {
+ testsend bogus
+ set result [winfo interps]
+ tk appname tktest
+ list $result [winfo interps]
+ } {{} tktest}
+ test unixSend-1.2 {RegOpen procedure, bogus property} {
+ testsend prop root InterpRegistry {}
+ set result [winfo interps]
+ tk appname tktest
+ list $result [winfo interps]
+ } {{} tktest}
+ test unixSend-1.3 {RegOpen procedure, bogus property} {
+ testsend prop root InterpRegistry abcdefg
+ tk appname tktest
+ set x [testsend prop root InterpRegistry]
+ string range $x [string first " " $x] end
+ } " tktest\nabcdefg\n"
+
+ frame .f -width 1 -height 1
+ set id [string range [winfo id .f] 2 end]
+ test unixSend-2.1 {RegFindName procedure} {
+ testsend prop root InterpRegistry {}
+ list [catch {send foo bar} msg] $msg
+ } {1 {no application named "foo"}}
+ test unixSend-2.2 {RegFindName procedure} {
+ testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
+ tk appname foo
+ } {foo #2}
+ test unixSend-2.3 {RegFindName procedure} {
+ testsend prop root InterpRegistry "gyz foo\n"
+ tk appname foo
+ } {foo}
+ test unixSend-2.4 {RegFindName procedure} {
+ testsend prop root InterpRegistry "${id}z foo\n"
+ tk appname foo
+ } {foo}
+
+ test unixSend-3.1 {RegDeleteName procedure} {
+ tk appname tktest
+ testsend prop root InterpRegistry "012345 gorp\n12345 foo\n12345 tktest"
+ tk appname x
+ set x [testsend prop root InterpRegistry]
+ string range $x [string first " " $x] end
+ } " x\n012345 gorp\n12345 foo\n"
+ test unixSend-3.2 {RegDeleteName procedure} {
+ tk appname tktest
+ testsend prop root InterpRegistry "012345 gorp\n12345 tktest\n23456 tktest"
+ tk appname x
+ set x [testsend prop root InterpRegistry]
+ string range $x [string first " " $x] end
+ } " x\n012345 gorp\n23456 tktest\n"
+ test unixSend-3.3 {RegDeleteName procedure} {
+ tk appname tktest
+ testsend prop root InterpRegistry "012345 tktest\n12345 bar\n23456 tktest"
+ tk appname x
+ set x [testsend prop root InterpRegistry]
+ string range $x [string first " " $x] end
+ } " x\n12345 bar\n23456 tktest\n"
+ test unixSend-3.4 {RegDeleteName procedure} {
+ tk appname tktest
+ testsend prop root InterpRegistry "foo"
+ tk appname x
+ set x [testsend prop root InterpRegistry]
+ string range $x [string first " " $x] end
+ } " x\nfoo\n"
+ test unixSend-3.5 {RegDeleteName procedure} {
+ tk appname tktest
+ testsend prop root InterpRegistry ""
+ tk appname x
+ set x [testsend prop root InterpRegistry]
+ string range $x [string first " " $x] end
+ } " x\n"
+
+ test unixSend-4.1 {RegAddName procedure} {
+ testsend prop root InterpRegistry ""
+ tk appname bar
+ testsend prop root InterpRegistry
+ } "$commId bar\n"
+ test unixSend-4.2 {RegAddName procedure} {
+ testsend prop root InterpRegistry "abc def"
+ tk appname bar
+ tk appname foo
+ testsend prop root InterpRegistry
+ } "$commId foo\nabc def\n"
+
+ # Previous checks should already cover the Regclose procedure.
+
+ test unixSend-5.1 {ValidateName procedure} {
+ testsend prop root InterpRegistry "123 abc\n"
+ winfo interps
+ } {}
+ test unixSend-5.2 {ValidateName procedure} {
+ testsend prop root InterpRegistry "$id Hi there"
+ winfo interps
+ } {{Hi there}}
+ test unixSend-5.3 {ValidateName procedure} {
+ testsend prop root InterpRegistry "$id Bogus"
+ list [catch {send Bogus set a 44} msg] $msg
+ } {1 {target application died or uses a Tk version before 4.0}}
+ test unixSend-5.4 {ValidateName procedure} {
+ tk appname test
+ testsend prop root InterpRegistry "$commId Bogus\n$commId test\n"
+ winfo interps
+ } {test}
+}
+
+winfo interps
+tk appname tktest
+update
+setupbg
+set x [split [exec xhost] \n]
+foreach i [lrange $x 1 end] {
+ exec xhost - $i
+}
+test unixSend-6.1 {ServerSecure procedure} {nonPortable} {
+ set a 44
+ list [dobg [list send [tk appname] set a 55]] $a
+} {55 55}
+test unixSend-6.2 {ServerSecure procedure} {nonPortable} {
+ set a 22
+ exec xhost [exec hostname]
+ list [catch {dobg [list send [tk appname] set a 33]} msg] $a $msg
+} {0 22 {X server insecure (must use xauth-style authorization); command ignored}}
+test unixSend-6.3 {ServerSecure procedure} {nonPortable} {
+ set a abc
+ exec xhost - [exec hostname]
+ list [dobg [list send [tk appname] set a new]] $a
+} {new new}
+cleanupbg
+
+if $gotTestCmds {
+ test unixSend-7.1 {Tk_SetAppName procedure} {
+ testsend prop root InterpRegistry ""
+ tk appname newName
+ list [tk appname oldName] [testsend prop root InterpRegistry]
+ } "oldName {$commId oldName\n}"
+ test unixSend-7.2 {Tk_SetAppName procedure, name not in use} {
+ testsend prop root InterpRegistry ""
+ list [tk appname gorp] [testsend prop root InterpRegistry]
+ } "gorp {$commId gorp\n}"
+ test unixSend-7.3 {Tk_SetAppName procedure, name in use by us} {
+ tk appname name1
+ testsend prop root InterpRegistry "$commId name2\n"
+ list [tk appname name2] [testsend prop root InterpRegistry]
+ } "name2 {$commId name2\n}"
+ test unixSend-7.4 {Tk_SetAppName procedure, name in use} {
+ tk appname name1
+ testsend prop root InterpRegistry "$id foo\n$id foo #2\n$id foo #3\n"
+ list [tk appname foo] [testsend prop root InterpRegistry]
+ } "{foo #4} {$commId foo #4\n$id foo\n$id foo #2\n$id foo #3\n}"
+}
+
+test unixSend-8.1 {Tk_SendCmd procedure, options} {
+ setupbg
+ set app [dobg {tk appname}]
+ set a 66
+ send -async $app [list send [tk appname] set a 77]
+ set result $a
+ after 200 set x 40
+ tkwait variable x
+ cleanupbg
+ lappend result $a
+} {66 77}
+if [info exists env(TK_ALT_DISPLAY)] {
+ test unixSend-8.2 {Tk_SendCmd procedure, options} {
+ setupbg -display $env(TK_ALT_DISPLAY)
+ tk appname xyzgorp
+ set a homeDisplay
+ set result [dobg "
+ toplevel .t -screen [winfo screen .]
+ wm geometry .t +0+0
+ set a altDisplay
+ tk appname xyzgorp
+ list \[send xyzgorp set a\] \[send -displayof .t xyzgorp set a\]
+ "]
+ cleanupbg
+ set result
+ } {altDisplay homeDisplay}
+}
+test unixSend-8.3 {Tk_SendCmd procedure, options} {
+ list [catch {send -- -async foo bar baz} msg] $msg
+} {1 {no application named "-async"}}
+test unixSend-8.4 {Tk_SendCmd procedure, options} {
+ list [catch {send -gorp foo bar baz} msg] $msg
+} {1 {bad option "-gorp": must be -async, -displayof, or --}}
+test unixSend-8.5 {Tk_SendCmd procedure, options} {
+ list [catch {send -async foo} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test unixSend-8.6 {Tk_SendCmd procedure, options} {
+ list [catch {send foo} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test unixSend-8.7 {Tk_SendCmd procedure, local execution} {
+ set a initial
+ send [tk appname] {set a new}
+ set a
+} {new}
+test unixSend-8.8 {Tk_SendCmd procedure, local execution} {
+ set a initial
+ send [tk appname] set a new
+ set a
+} {new}
+test unixSend-8.9 {Tk_SendCmd procedure, local execution} {
+ set a initial
+ string tolower [list [catch {send [tk appname] open bad_file} msg] \
+ $msg $errorInfo $errorCode]
+} {1 {couldn't open "bad_file": no such file or directory} {couldn't open "bad_file": no such file or directory
+ while executing
+"open bad_file"
+ invoked from within
+"send [tk appname] open bad_file"} {posix enoent {no such file or directory}}}
+test unixSend-8.10 {Tk_SendCmd procedure, no such interpreter} {
+ list [catch {send bogus_name bogus_command} msg] $msg
+} {1 {no application named "bogus_name"}}
+if $gotTestCmds {
+ newApp "" t_s_1 Test
+ t_s_1 eval wm withdraw .
+ test unixSend-8.11 {Tk_SendCmd procedure, local execution, different interp} {
+ set a us
+ send t_s_1 set a them
+ list $a [send t_s_1 set a]
+ } {us them}
+ test unixSend-8.12 {Tk_SendCmd procedure, local execution, different interp} {
+ set a us
+ send t_s_1 {set a them}
+ list $a [send t_s_1 {set a}]
+ } {us them}
+ test unixSend-8.13 {Tk_SendCmd procedure, local execution, different interp} {
+ set a us
+ send t_s_1 {set a them}
+ list $a [send t_s_1 {set a}]
+ } {us them}
+ test unixSend-8.14 {Tk_SendCmd procedure, local interp killed by send} {
+ newApp "" t_s_2 Test
+ list [catch {send t_s_2 {destroy .; concat result}} msg] $msg
+ } {0 result}
+ interp delete t_s_2
+ test unixSend-8.15 {Tk_SendCmd procedure, local interp, error info} {
+ catch {error foo}
+ list [catch {send t_s_1 {if 1 {open bogus_file_name}}} msg] $msg $errorInfo $errorCode
+ } {1 {couldn't open "bogus_file_name": no such file or directory} {couldn't open "bogus_file_name": no such file or directory
+ while executing
+"open bogus_file_name"
+ invoked from within
+"if 1 {open bogus_file_name}"
+ invoked from within
+"send t_s_1 {if 1 {open bogus_file_name}}"} {POSIX ENOENT {no such file or directory}}}
+ test unixSend-8.16 {Tk_SendCmd procedure, bogusCommWindow} {
+ testsend prop root InterpRegistry "10234 bogus\n"
+ set result [list [catch {send bogus bogus command} msg] $msg]
+ winfo interps
+ tk appname tktest
+ set result
+ } {1 {no application named "bogus"}}
+ interp delete t_s_1
+}
+test unixSend-8.17 {Tk_SendCmd procedure, deferring events} {nonPortable} {
+ # Non-portable because some window managers ignore "raise"
+ # requests so can't guarantee that new app's window won't
+ # obscure .f, thereby masking the Expose event.
+
+ setupbg
+ set app [dobg {tk appname}]
+ raise . ; # Don't want new app obscuring .f
+ catch {destroy .f}
+ frame .f
+ place .f -x 0 -y 0
+ bind .f <Expose> {set a exposed}
+ set a {no event yet}
+ set result ""
+ lappend result [send $app send [list [tk appname]] set a]
+ lappend result $a
+ update
+ cleanupbg
+ lappend result $a
+} {{no event yet} {no event yet} exposed}
+test unixSend-8.18 {Tk_SendCmd procedure, error in remote app} {
+ setupbg
+ set app [dobg {tk appname}]
+ set result [string tolower [list [catch {send $app open bad_name} msg] \
+ $msg $errorInfo $errorCode]]
+ cleanupbg
+ set result
+} {1 {couldn't open "bad_name": no such file or directory} {couldn't open "bad_name": no such file or directory
+ while executing
+"open bad_name"
+ invoked from within
+"send $app open bad_name"} {posix enoent {no such file or directory}}}
+test unixSend-8.19 {Tk_SendCmd, using modal timeouts} {
+ setupbg
+ set app [dobg {tk appname}]
+ set x no
+ set result ""
+ after 0 {set x yes}
+ lappend result [send $app {concat x y z}]
+ lappend result $x
+ update
+ cleanupbg
+ lappend result $x
+} {{x y z} no yes}
+
+tk appname tktest
+catch {destroy .f}
+frame .f
+set id [string range [winfo id .f] 2 end]
+if $gotTestCmds {
+ test unixSend-9.1 {Tk_GetInterpNames procedure} {
+ testsend prop root InterpRegistry \
+ "$commId tktest\nfoo bar\n$commId tktest\n$id frame .f\n\n\n"
+ list [winfo interps] [testsend prop root InterpRegistry]
+ } "{tktest tktest {frame .f}} {$commId tktest\n$commId tktest\n$id frame .f
+}"
+ test unixSend-9.2 {Tk_GetInterpNames procedure} {
+ testsend prop root InterpRegistry \
+ "$commId tktest\nfoobar\n$commId gorp\n"
+ list [winfo interps] [testsend prop root InterpRegistry]
+ } "tktest {$commId tktest\n}"
+ test unixSend-9.3 {Tk_GetInterpNames procedure} {
+ testsend prop root InterpRegistry {}
+ list [winfo interps] [testsend prop root InterpRegistry]
+ } {{} {}}
+
+ testsend prop root InterpRegistry "$commId tktest\n$id dummy\n"
+ test unixSend-10.1 {SendEventProc procedure, bogus comm property} {
+ testsend prop comm Comm {abc def}
+ testsend prop comm Comm {}
+ update
+ } {}
+ test unixSend-10.2 {SendEventProc procedure, simultaneous messages} {
+ testsend prop comm Comm \
+ "c\n-n tktest\n-s set a 44\nc\n-n tktest\n-s set b 45\n"
+ set a null
+ set b xyzzy
+ update
+ list $a $b
+ } {44 45}
+ test unixSend-10.3 {SendEventProc procedure, simultaneous messages} {
+ testsend prop comm Comm \
+ "c\n-n tktest\n-s set a newA\nr\n-s [testsend serial]\n-r 12345\nc\n-n tktest\n-s set b newB\n"
+ set a null
+ set b xyzzy
+ set x [send dummy bogus]
+ list $x $a $b
+ } {12345 newA newB}
+ test unixSend-10.4 {SendEventProc procedure, leading nulls, bogus commands} {
+ testsend prop comm Comm \
+ "\n\nx\n-bogus\n\nc\n-n tktest\n-s set a 44\n"
+ set a null
+ update
+ set a
+ } {44}
+ test unixSend-10.5 {SendEventProc procedure, extraneous command options} {
+ testsend prop comm Comm \
+ "c\n-n tktest\n-x miscellanous\n-y who knows?\n-s set a new\n"
+ set a null
+ update
+ set a
+ } {new}
+ test unixSend-10.6 {SendEventProc procedure, unknown interpreter} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n unknown\n-r $id 44\n-s set a new\n"
+ set a null
+ update
+ list [testsend prop [winfo id .f] Comm] $a
+ } "{\nr\n-s 44\n-r receiver never heard of interpreter \"unknown\"\n-c 1\n} null"
+ test unixSend-10.7 {SendEventProc procedure, error in script} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n tktest\n-r $id 62\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
+ update
+ testsend prop [winfo id .f] Comm
+ } {
+r
+-s 62
+-r test error
+-i Initial errorInfo
+ ("foreach" body line 1)
+ invoked from within
+"foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}"
+-e test code
+-c 1
+}
+ test unixSend-10.8 {SendEventProc procedure, exceptional return} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n tktest\n-r $id 62\n-s break\n"
+ update
+ testsend prop [winfo id .f] Comm
+ } {
+r
+-s 62
+-r
+-c 3
+}
+ test unixSend-10.9 {SendEventProc procedure, empty return} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n tktest\n-r $id 62\n-s concat\n"
+ update
+ testsend prop [winfo id .f] Comm
+ } {
+r
+-s 62
+-r
+}
+ test unixSend-10.10 {SendEventProc procedure, asynchronous calls} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n tktest\n-s foreach i {1 2 3} {error {test error} {Initial errorInfo} {test code}}\n"
+ update
+ testsend prop [winfo id .f] Comm
+ } {}
+ test unixSend-10.11 {SendEventProc procedure, exceptional return} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n tktest\n-s break\n"
+ update
+ testsend prop [winfo id .f] Comm
+ } {}
+ test unixSend-10.12 {SendEventProc procedure, empty return} {
+ testsend prop [winfo id .f] Comm {}
+ testsend prop comm Comm \
+ "c\n-n tktest\n-s concat\n"
+ update
+ testsend prop [winfo id .f] Comm
+ } {}
+ test unixSend-10.13 {SendEventProc procedure, return processing} {
+ testsend prop comm Comm \
+ "r\n-c 1\n-e test1\n-i test2\n-r test3\n-s [testsend serial]\n"
+ list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
+ } {1 test3 {test2
+ invoked from within
+"send dummy foo"} test1}
+ test unixSend-10.14 {SendEventProc procedure, extraneous return options} {
+ testsend prop comm Comm \
+ "r\n-x test1\n-y test2\n-r result\n-s [testsend serial]\n"
+ list [catch {send dummy foo} msg] $msg
+ } {0 result}
+ test unixSend-10.15 {SendEventProc procedure, serial number} {
+ testsend prop comm Comm \
+ "r\n-r response\n"
+ list [catch {send dummy foo} msg] $msg
+ } {1 {target application died or uses a Tk version before 4.0}}
+ test unixSend-10.16 {SendEventProc procedure, serial number} {
+ testsend prop comm Comm \
+ "r\n-r response\n\n-s 0"
+ list [catch {send dummy foo} msg] $msg
+ } {1 {target application died or uses a Tk version before 4.0}}
+ test unixSend-10.17 {SendEventProc procedure, errorCode and errorInfo} {
+ testsend prop comm Comm \
+ "r\n-i test1\n-e test2\n-c 4\n-s [testsend serial]\n"
+ set errorCode oldErrorCode
+ set errorInfo oldErrorInfo
+ list [catch {send dummy foo} msg] $msg $errorInfo $errorCode
+ } {4 {} oldErrorInfo oldErrorCode}
+ test unixSend-10.18 {SendEventProc procedure, send kills application} {
+ setupbg
+ dobg {tk appname t_s_3}
+ set x [list [catch {send t_s_3 destroy .} msg] $msg]
+ cleanupbg
+ set x
+ } {0 {}}
+ test unixSend-10.19 {SendEventProc procedure, send exits} {
+ setupbg
+ dobg {tk appname t_s_3}
+ set x [list [catch {send t_s_3 exit} msg] $msg]
+ close $::tcltest::fd
+ set x
+ } {1 {target application died}}
+
+ test unixSend-11.1 {AppendPropCarefully and AppendErrorProc procedures} {
+ testsend prop root InterpRegistry "0x21447 dummy\n"
+ list [catch {send dummy foo} msg] $msg
+ } {1 {no application named "dummy"}}
+ test unixSend-11.2 {AppendPropCarefully and AppendErrorProc procedures} {
+ testsend prop comm Comm "c\n-r0x123 44\n-n tktest\n-s concat a b c\n"
+ update
+ } {}
+}
+
+winfo interps
+tk appname tktest
+catch {destroy .f}
+frame .f
+set id [string range [winfo id .f] 2 end]
+if $gotTestCmds {
+ test unixSend-12.1 {TimeoutProc procedure} {
+ testsend prop root InterpRegistry "$id dummy\n"
+ list [catch {send dummy foo} msg] $msg
+ } {1 {target application died or uses a Tk version before 4.0}}
+ testsend prop root InterpRegistry ""
+}
+test unixSend-12.2 {TimeoutProc procedure} {
+ winfo interps
+ tk appname tktest
+ update
+ setupbg
+ puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
+ set ::tcltest::bgDone 0
+ set ::tcltest::bgData {}
+ flush $::tcltest::fd
+ tkwait variable ::tcltest::bgDone
+ set app $::tcltest::bgData
+ after 200
+ set result [list [catch {send $app foo} msg] $msg]
+ close $::tcltest::fd
+ set result
+} {1 {target application died}}
+
+winfo interps
+tk appname tktest
+test unixSend-13.1 {DeleteProc procedure} {
+ setupbg
+ set app [dobg {rename send {}; tk appname}]
+ set result [list [catch {send $app foo} msg] $msg [winfo interps]]
+ cleanupbg
+ set result
+} {1 {no application named "tktest #2"} tktest}
+test unixSend-13.2 {DeleteProc procedure} {
+ winfo interps
+ tk appname tktest
+ rename send {}
+ set result {}
+ lappend result [winfo interps] [info commands send]
+ tk appname foo
+ lappend result [winfo interps] [info commands send]
+} {{} {} foo send}
+
+if [info exists env(TK_ALT_DISPLAY)] {
+ test unixSend-14.1 {SendRestrictProc procedure, sends crossing from different displays} {
+ setupbg -display $env(TK_ALT_DISPLAY)
+ set result [dobg "
+ toplevel .t -screen [winfo screen .]
+ wm geometry .t +0+0
+ tk appname xyzgorp1
+ set x child
+ "]
+ toplevel .t -screen $env(TK_ALT_DISPLAY)
+ wm geometry .t +0+0
+ tk appname xyzgorp2
+ update
+ set y parent
+ set result [send -displayof .t xyzgorp1 {list $x [send -displayof .t xyzgorp2 set y]}]
+ destroy .t
+ cleanupbg
+ set result
+ } {child parent}
+}
+
+if $gotTestCmds {
+ testsend prop root InterpRegister $registry
+ tk appname tktest
+ test unixSend-15.1 {UpdateCommWindow procedure} {
+ set x [list [testsend prop comm TK_APPLICATION]]
+ newApp "" t_s_1 Test
+ send t_s_1 wm withdraw .
+ newApp "" t_s_2 Test
+ send t_s_2 wm withdraw .
+ lappend x [testsend prop comm TK_APPLICATION]
+ interp delete t_s_1
+ lappend x [testsend prop comm TK_APPLICATION]
+ interp delete t_s_2
+ lappend x [testsend prop comm TK_APPLICATION]
+ } {tktest {t_s_2 t_s_1 tktest} {t_s_2 tktest} tktest}
+}
+
+tk appname $name
+if $gotTestCmds {
+ testsend prop root InterpRegistry $registry
+}
+if $gotTestCmds {
+ testdeleteapps
+}
+rename newApp {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/unixWm.test b/tk/tests/unixWm.test
index 376026d8256..78cb9e4b058 100644
--- a/tk/tests/unixWm.test
+++ b/tk/tests/unixWm.test
@@ -4,18 +4,19 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {$tcl_platform(platform) != "unix"} {
+ puts "skipping: Unix only tests..."
+ ::tcltest::cleanupTests
+ return
}
proc sleep ms {
@@ -195,7 +196,7 @@ test unixWm-6.3 {size changes} {
update
wm geom .t
} 170x140+10+10
-test unixWm-6.4 {size changes} {nonPortable} {
+test unixWm-6.4 {size changes} {nonPortable userInteraction} {
wm minsize .t 1 1
update
puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
@@ -352,9 +353,35 @@ test unixWm-8.9 {icon windows} {nonPortable} {
lappend result [winfo ismapped .icon] [wm state .icon]
} {icon 1 0 0 withdrawn 1 normal}
+test unixWm-59.1 {test for memory leaks} {
+ 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-59.2 {test for memory leaks} {
+ 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
+
if {[string compare testwrapper [info commands testwrapper]] != 0} {
puts "This application hasn't been compiled with the testwrapper command,"
puts "therefore I am skipping all of these tests."
+ ::tcltest::cleanupTests
return
}
@@ -820,6 +847,7 @@ 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]
@@ -833,6 +861,7 @@ test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {
update
set result [winfo ismapped .t2]
wm iconify .t2
+ update
lappend result [winfo ismapped .t2]
destroy .t2
set result
@@ -1182,8 +1211,11 @@ test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} {
test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {
list [catch {wm state .t 1} msg] $msg
-} {1 {wrong # arguments: must be "wm state window"}}
+} {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 # arguments: must 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
@@ -1200,6 +1232,23 @@ test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
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
@@ -1309,7 +1358,7 @@ test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
sleep 500
lappend result [winfo width .t] [winfo height .t]
} {400 150 200 300}
-test unixWm-41.2 {ConfigureEvent procedure, menubars} {unixOnly} {
+test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} {
catch {destroy .t}
toplevel .t -width 300 -height 200 -bd 2 -relief raised
wm geom .t +0+0
@@ -1473,22 +1522,26 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
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} {
- catch {destroy .t}
- toplevel .t -width 80 -height 60
wm geometry .t +5-10
wm overrideredirect .t 1
tkwait visibility .t
list [winfo x .t] [winfo y .t]
-} "5 [expr [winfo screenheight .t] - 70]"
+} [list 5 [expr [winfo screenheight .t] - 70]]
+
+catch {destroy .t}
+toplevel .t -width 80 -height 60
test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {
- catch {destroy .t}
- toplevel .t -width 80 -height 60
wm geometry .t -30+2
wm overrideredirect .t 1
tkwait visibility .t
list [winfo x .t] [winfo y .t]
-} "[expr [winfo screenwidth .t] - 110] 2"
+} [list [expr [winfo screenwidth .t] - 110] 2]
+catch {destroy .t}
+
test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} {
catch {destroy .t}
toplevel .t -width 80 -height 60
@@ -1588,7 +1641,7 @@ test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} {
list $result $x
} {no yes}
-test unixWm-47.1 {WaitRestrictProc procedure} {
+test unixWm-47.1 {WaitRestrictProc procedure} {nonPortable} {
catch {destroy .t}
toplevel .t -width 300 -height 200
frame .t.f -bd 2 -relief raised
@@ -1603,6 +1656,7 @@ test unixWm-47.1 {WaitRestrictProc procedure} {
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
@@ -2291,6 +2345,37 @@ test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} {
lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
} {0 20 0 1}
+test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 50
+ wm geom .t +0+0
+ wm command .t "argumentNumber0 argumentNumber1 argumentNumber2 argumentNumber0 argumentNumber3 argumentNumber4 argumentNumber5 argumentNumber6 argumentNumber0 argumentNumber7 argumentNumber8 argumentNumber9 argumentNumber10 argumentNumber0 argumentNumber11 argumentNumber12 argumentNumber13 argumentNumber14 argumentNumber15 argumentNumber16 argumentNumber17 argumentNumber18"
+ update
+ testprop [testwrapper .t] WM_COMMAND
+} {argumentNumber0
+argumentNumber1
+argumentNumber2
+argumentNumber0
+argumentNumber3
+argumentNumber4
+argumentNumber5
+argumentNumber6
+argumentNumber0
+argumentNumber7
+argumentNumber8
+argumentNumber9
+argumentNumber10
+argumentNumber0
+argumentNumber11
+argumentNumber12
+argumentNumber13
+argumentNumber14
+argumentNumber15
+argumentNumber16
+argumentNumber17
+argumentNumber18
+}
+
# Test exit processing and cleanup:
test unixWm-58.1 {exit processing} {
@@ -2301,7 +2386,7 @@ test unixWm-58.1 {exit processing} {
exit
}
close $fd
- if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+ if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
set error 1
} else {
set error 0
@@ -2320,7 +2405,7 @@ test unixWm-58.2 {exit processing} {
exit
}
close $fd
- if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+ if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
set error 1
} else {
set error 0
@@ -2345,7 +2430,7 @@ test unixWm-58.3 {exit processing} {
exit
}
close $fd
- if {[catch {exec $tktest script -geometry 10x10+0+0} msg]} {
+ if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} {
set error 1
} else {
set error 0
@@ -2353,6 +2438,23 @@ test unixWm-58.3 {exit processing} {
list $error $msg
} {0 {}}
-
+
+# cleanup
catch {destroy .t}
-concat {}
+catch {removeFile script}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/util.test b/tk/tests/util.test
index 416de65957f..b7399427898 100644
--- a/tk/tests/util.test
+++ b/tk/tests/util.test
@@ -3,14 +3,14 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[string compare test [info procs test]] == 1} then \
- {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
foreach i [winfo children .] {
destroy $i
@@ -68,3 +68,20 @@ test util-1.11 {Tk_GetScrollInfo procedure} {
test util-1.12 {Tk_GetScrollInfo procedure} {
list [catch {.l yview dropdead 3 times} msg] $msg
} {1 {unknown option "dropdead": must be moveto or scroll}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/visual.test b/tk/tests/visual.test
index 82408bf061b..4b2ef3e05b6 100644
--- a/tk/tests/visual.test
+++ b/tk/tests/visual.test
@@ -4,14 +4,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -310,3 +309,20 @@ foreach w [winfo child .] {
}
rename eatColors {}
rename colorsFree {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/visual_bb.test b/tk/tests/visual_bb.test
new file mode 100644
index 00000000000..e0eea2fc5b2
--- /dev/null
+++ b/tk/tests/visual_bb.test
@@ -0,0 +1,111 @@
+#!/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$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+set auto_path ". $auto_path"
+wm title . "Visual Tests for Tk"
+
+set testNum 1
+
+# Each menu entry invokes a visual test file
+
+proc runTest {file} {
+ global testNum
+
+ test "2.$testNum" "testing $file" {userInteraction} {
+ uplevel \#0 source [file join $::tcltest::testsDir $file]
+ concat ""
+ } {}
+ incr testNum
+}
+
+# The following procedure is invoked to print the contents of a canvas:
+
+proc lpr c {
+ exec rm -f tmp.ps
+ $c postscript -file tmp.ps
+ exec lpr tmp.ps
+ exec rm -f tmp.ps
+}
+
+test 1.1 "running visual tests" {userInteraction} {
+
+ #-------------------------------------------------------
+ # The code below create the main window, consisting of a
+ # menu bar and a message explaining the basic operation
+ # of the program.
+ #-------------------------------------------------------
+
+ frame .menu -relief raised -borderwidth 1
+ message .msg -font {Times 18} -relief raised -width 4i \
+ -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit. Each menu entry invokes a test, which displays information on the screen. You can then verify visually that the information is being displayed in the correct way. The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
+
+ pack .menu -side top -fill x
+ pack .msg -side bottom -expand yes -fill both
+
+ #-------------------------------------------------------
+ # The code below creates all the menus, which invoke procedures
+ # to create particular demonstrations of various widgets.
+ #-------------------------------------------------------
+
+ menubutton .menu.file -text "File" -menu .menu.file.m
+ menu .menu.file.m
+ .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests
+
+ menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
+ menu .menu.group1.m
+ .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
+ .menu.group1.m add command -label "Beveled borders in text widgets" \
+ -command {runTest bevel.tcl}
+ .menu.group1.m add command -label "Colormap management" \
+ -command {runTest cmap.tcl}
+ .menu.group1.m add command -label "Label/button geometry" \
+ -command {runTest butGeom.tcl}
+ .menu.group1.m add command -label "Label/button colors" \
+ -command {runTest butGeom2.tcl}
+
+ menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
+ menu .menu.ps.m
+ .menu.ps.m add command -label "Rectangles and other graphics" \
+ -command {runTest canvPsGrph.tcl}
+ .menu.ps.m add command -label "Text" \
+ -command {runTest canvPsText.tcl}
+ .menu.ps.m add command -label "Bitmaps" \
+ -command {runTest canvPsBmap.tcl}
+ .menu.ps.m add command -label "Images" \
+ -command {source 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 {!$::tcltest::testConfig(userInteraction)} {
+ ::tcltest::cleanupTests
+}
diff --git a/tk/tests/winButton.test b/tk/tests/winButton.test
index 509aaa258c7..9e2a2e17b88 100644
--- a/tk/tests/winButton.test
+++ b/tk/tests/winButton.test
@@ -5,27 +5,23 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform)!="windows"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\""
puts "image, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
foreach i [winfo children .] {
destroy $i
}
@@ -47,7 +43,7 @@ radiobutton .r -text Radiobutton
pack .l .b .c .r
update
-test winbutton-1.1 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.1 {TkpComputeButtonGeometry procedure} {pcOnly} {
eval destroy [winfo children .]
image create test image1
image1 changed 0 0 0 0 60 40
@@ -62,7 +58,7 @@ test winbutton-1.1 {TkpComputeButtonGeometry procedure} {
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} {68 48 71 51 96 50 96 50}
-test winbutton-1.2 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.2 {TkpComputeButtonGeometry procedure} {pcOnly} {
eval destroy [winfo children .]
label .b1 -bitmap question -bd 3 -padx 0 -pady 2
button .b2 -bitmap question -bd 3 -padx 0 -pady 2
@@ -75,7 +71,7 @@ test winbutton-1.2 {TkpComputeButtonGeometry procedure} {
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} {23 33 26 36 51 35 51 35}
-test winbutton-1.3 {TkpComputeButtonGeometry procedure} {
+test winbutton-1.3 {TkpComputeButtonGeometry procedure} {pcOnly} {
eval destroy [winfo children .]
label .b1 -bitmap question -bd 3 -highlightthickness 4
button .b2 -bitmap question -bd 3 -highlightthickness 0
@@ -89,7 +85,7 @@ test winbutton-1.3 {TkpComputeButtonGeometry procedure} {
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} {31 41 24 34 26 36 26 36}
-test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.4 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
eval destroy [winfo children .]
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -font {{MS Sans Serif} 8}
@@ -102,21 +98,21 @@ test winbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable} {
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} {58 24 67 33 88 30 90 28}
-test winbutton-1.5 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.5 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
eval destroy [winfo children .]
label .l1 -text "This is a long string that will wrap around on several lines.\n\nIt also has a blank line (above)." -wraplength 1.5i -padx 0 -pady 0
pack .l1
update
list [winfo reqwidth .l1] [winfo reqheight .l1]
} {178 84}
-test winbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.6 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
eval destroy [winfo children .]
label .l1 -text "This is a long string without wrapping.\n\nIt also has a blank line (above)." -padx 0 -pady 0
pack .l1
update
list [winfo reqwidth .l1] [winfo reqheight .l1]
} {222 52}
-test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.7 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
eval destroy [winfo children .]
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 -width 10
button .b2 -text Xagqpim -bd 2 -padx 0 -pady 2 -height 5
@@ -129,7 +125,7 @@ test winbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable} {
[winfo reqwidth .b3] [winfo reqheight .b3] \
[winfo reqwidth .b4] [winfo reqheight .b4]
} {74 24 67 97 174 46 64 28}
-test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} {
+test winbutton-1.8 {TkpComputeButtonGeometry procedure} {pcOnly nonPortable} {
eval destroy [winfo children .]
label .b1 -text Xagqpim -bd 2 -padx 0 -pady 2 \
-highlightthickness 4
@@ -145,10 +141,26 @@ test winbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable} {
[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} {
+test winbutton-1.9 {TkpComputeButtonGeometry procedure} {pcOnly} {
eval destroy [winfo children .]
button .b2 -bitmap question -default normal
list [winfo reqwidth .b2] [winfo reqheight .b2]
} {24 34}
+# cleanup
eval destroy [winfo children .]
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/winClipboard.test b/tk/tests/winClipboard.test
index 58a2b2c1c79..aaf29678ece 100644
--- a/tk/tests/winClipboard.test
+++ b/tk/tests/winClipboard.test
@@ -7,41 +7,80 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform)!="windows"} {
- return
-}
-
-if {[string compare test [info procs test]] == 1} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
# Note that these tests may fail if another application is grabbing the
# clipboard (e.g. an X server)
-test winClipboard-1.1 {TkSelGetSelection} {
+if {[llength [info command testclipboard]] == 0} {
+ puts "\"testclipboard\" isn't defined, skipping winClipboard tests"
+ ::tcltest::cleanupTests
+ return
+}
+
+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} {
+test winClipboard-1.2 {TkSelGetSelection} {pcOnly} {
clipboard clear
clipboard append {}
list [selection get -selection CLIPBOARD] [testclipboard]
} {{} {}}
-test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {
+test winClipboard-1.3 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
clipboard clear
clipboard append abcd
+ update
list [selection get -selection CLIPBOARD] [testclipboard]
} {abcd abcd}
-test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {
+test winClipboard-1.4 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
clipboard clear
clipboard append "line 1\nline 2"
list [selection get -selection CLIPBOARD] [testclipboard]
} [list "line 1\nline 2" "line 1\r\nline 2"]
+test winClipboard-1.5 {TkSelGetSelection & TkWinClipboardRender} {pcOnly} {
+ clipboard clear
+ clipboard append "line 1\u00c7\nline 2"
+ list [selection get -selection CLIPBOARD] [testclipboard]
+} [list "line 1\u00c7\nline 2" [bytestring "line 1\u00c7\r\nline 2"]]
+
+test winClipboard-2.1 {TkSelUpdateClipboard reentrancy problem} {pcOnly} {
+ clipboard clear
+ clipboard append -type OUR_ACTION "action data"
+ clipboard append "string data"
+ update
+ list [selection get -selection CLIPBOARD -type OUR_ACTION] [testclipboard]
+} [list "action data" "string data"]
+test winClipboard-2.2 {TkSelUpdateClipboard reentrancy problem} {pcOnly} {
+ clipboard clear
+ clipboard append -type OUR_ACTION "new data"
+ clipboard append "more data in string"
+ update
+ list [testclipboard] [selection get -selection CLIPBOARD -type OUR_ACTION]
+} [list "more data in string" "new data"]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/winDialog.test b/tk/tests/winDialog.test
new file mode 100644
index 00000000000..4d01ae9d1c3
--- /dev/null
+++ b/tk/tests/winDialog.test
@@ -0,0 +1,333 @@
+# This file is a Tcl script to test the Windows specific behavior of
+# the common dialog boxes. It is organized in the standard
+# fashion for Tcl tests.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info command testwinevent] == ""} {
+ puts "skipping: tests require the testwinevent command"
+ ::tcltest::cleanupTests
+ return
+}
+
+testwinevent debug 1
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+proc start {arg} {
+ set ::tk_dialog 0
+ 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 100 {afterbody}
+ return
+ }
+ uplevel #0 {set dialogresult [eval $command]}
+}
+
+proc Click {button} {
+ testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
+ testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
+}
+
+proc GetText {button} {
+ return [testwinevent $::tk_dialog $button WM_GETTEXT]
+}
+
+proc SetText {button text} {
+ return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
+}
+
+test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
+} {}
+
+test winDialog-2.1 {ColorDlgHookProc} {nt} {
+} {}
+
+test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} {
+ start {tk_getOpenFile}
+ then {
+ set x [GetText 2]
+ Click 2
+ }
+ set x
+} {Cancel}
+
+test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} {
+ start {tk_getSaveFile}
+ then {
+ set x [GetText 2]
+ Click 2
+ }
+ set x
+} {Cancel}
+
+test winDialog-5.1 {GetFileName: no arguments} {nt} {
+ start {tk_getOpenFile -title Open}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.2 {GetFileName: one argument} {nt} {
+ list [catch {tk_getOpenFile -foo} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+test winDialog-5.4 {GetFileName: many arguments} {nt} {
+ start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
+ list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
+} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
+test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} {
+ start {tk_getOpenFile -title bar}
+ then {
+ Click cancel
+ }
+} {0}
+test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
+ list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
+} {1 {value for "-title" missing}}
+test winDialog-5.8 {GetFileName: extension begins with .} {nt} {
+# if (string[0] == '.') {
+# string++;
+# }
+
+ start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
+ then {
+ SetText 0x480 bar
+ Click 1
+ }
+ set x
+} [file join [pwd] bar.foo]
+test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
+ start {set x [tk_getSaveFile -defaultextension foo -title Save]}
+ then {
+ SetText 0x480 bar
+ Click 1
+ }
+ set x
+} [file join [pwd] bar.foo]
+test winDialog-5.10 {GetFileName: file types} {nt} {
+# case FILE_TYPES:
+
+ start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
+ then {
+ set x [GetText 0x470]
+ Click cancel
+ }
+ set x
+} {foo files (*.foo)}
+test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
+# if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)
+
+ list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
+} {1 {bad Macintosh file type "FOO"}}
+test winDialog-5.12 {GetFileName: initial directory} {nt} {
+# case FILE_INITDIR:
+
+ start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
+ then {
+ Click 1
+ }
+ set x
+} {C:/12x 455}
+test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
+ {nt} {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+
+ list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+test winDialog-5.14 {GetFileName: initial file} {nt} {
+# case FILE_INITFILE:
+
+ start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
+ then {
+ Click 1
+ }
+ set x
+} [file join [pwd] "12x 456"]
+test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
+# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
+ list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
+} {1 {user "12x" doesn't exist}}
+set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+append a $a
+append a $a
+append a $a
+append a $a
+test winDialog-5.16 {GetFileName: initial file: long name} {nt} {
+ start {set x [tk_getSaveFile -initialfile $a -title Long]}
+ then {
+ Click 1
+ }
+ set x
+} [string range [file join [pwd] $a] 0 257]
+test winDialog-5.17 {GetFileName: parent} {nt} {
+# case FILE_PARENT:
+
+ toplevel .t
+ set x 0
+ start {tk_getOpenFile -parent .t -title Parent; set x 1}
+ then {
+ destroy .t
+ }
+ set x
+} {1}
+test winDialog-5.18 {GetFileName: title} {nt} {
+# case FILE_TITLE:
+
+ start {tk_getOpenFile -title Narf}
+ then {
+ Click 2
+ }
+} {0}
+test winDialog-5.19 {GetFileName: no filter specified} {nt} {
+# if (ofn.lpstrFilter == NULL)
+
+ start {tk_getOpenFile -title Filter}
+ then {
+ set x [GetText 0x470]
+ Click 2
+ }
+ set x
+} {All Files (*.*)}
+test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
+# if (Tk_WindowId(parent) == None)
+
+ toplevel .t
+ start {tk_getOpenFile -parent .t -title Open}
+ then {
+ destroy .t
+ }
+} {}
+test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
+ toplevel .t
+ update
+ start {tk_getOpenFile -parent .t -title Open}
+ then {
+ destroy .t
+ }
+} {}
+test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} {
+# winCode = GetOpenFileName(&ofn);
+
+ start {tk_getOpenFile -title Open}
+ then {
+ set x [GetText 1]
+ Click 2
+ }
+ set x
+} {&Open}
+test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt} {
+# winCode = GetSaveFileName(&ofn);
+
+ start {tk_getSaveFile -title Save}
+ then {
+ set x [GetText 1]
+ Click 2
+ }
+ set x
+} {&Save}
+test winDialog-5.24 {GetFileName: convert \ to /} {nt} {
+ start {set x [tk_getSaveFile -title Back]}
+ then {
+ SetText 0x480 "c:\\12x 457"
+ Click 1
+ }
+ set x
+} {c:/12x 457}
+
+test winDialog-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} {
+ 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} {
+ 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} {
+ 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} {
+# 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}}
+
+testwinevent debug 0
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/winFont.test b/tk/tests/winFont.test
index 294f4e0dd7e..9e8949a7d30 100644
--- a/tk/tests/winFont.test
+++ b/tk/tests/winFont.test
@@ -7,24 +7,20 @@
# but there are no results that can be checked.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform)!="windows"} {
- return
-}
-
-if {[string compare test [info procs test]] != 0} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
catch {destroy .b}
catch {font delete xyz}
toplevel .b
+wm geometry .b +0+0
update idletasks
set courier {Courier 14}
@@ -45,10 +41,10 @@ proc getsize {} {
return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
}
-test winfont-1.1 {TkpGetNativeFont procedure: not native} {
+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} {
+test winfont-1.2 {TkpGetNativeFont procedure: native} {pcOnly} {
font measure ansifixed 0
font measure ansi 0
font measure device 0
@@ -58,98 +54,99 @@ test winfont-1.2 {TkpGetNativeFont procedure: native} {
set x {}
} {}
-test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {
+test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
expr [font actual {-size -10} -size]>0
} {1}
-test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {
+test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {pcOnly} {
expr [font actual {-family Arial} -size]>0
} {1}
-test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {
+test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {pcOnly} {
font actual {-weight normal} -weight
} {normal}
-test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {
+test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {pcOnly} {
font actual {-weight bold} -weight
} {bold}
-test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {
+test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {pcOnly} {
catch {expr {[font actual {-size 10} -size]}}
} 0
-test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {
+test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {pcOnly} {
font actual {-family Arial} -family
} {Arial}
-test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {
+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} {
+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} {
+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} {
+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} {
+test winfont-3.1 {TkpDeleteFont procedure} {pcOnly} {
font actual {-family xyz}
set x {}
} {}
-test winfont-4.1 {TkpGetFontFamilies procedure} {
+test winfont-4.1 {TkpGetFontFamilies procedure} {pcOnly} {
font families
set x {}
} {}
-test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {nonPortable} {
+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]
@@ -158,12 +155,12 @@ test winfont-5.10 {Tk_MeasureChars procedure: check for kerning} {nonPortable} {
.b.l config -font $font
expr $x < ($width*10)
} 1
-test winfont-6.1 {Tk_DrawChars procedure: loop test} {
+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} {
+test winfont-7.1 {AllocFont procedure: use old font} {pcOnly} {
font create xyz
catch {destroy .c}
button .c -font xyz
@@ -172,14 +169,29 @@ test winfont-7.1 {AllocFont procedure: use old font} {
destroy .c
font delete xyz
} {}
-test winfont-7.2 {AllocFont procedure: extract info from logfont} {
+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} {
+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} {
+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/tk/tests/winMenu.test b/tk/tests/winMenu.test
index 9274d604d91..ae9d74a0d92 100644
--- a/tk/tests/winMenu.test
+++ b/tk/tests/winMenu.test
@@ -4,37 +4,23 @@
# system.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "windows"} {
- return
-}
-
-if {![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
- set testConfig(menuInteractive) 0
-} else {
- set testConfig(menuInteractive) 1
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
if {[lsearch [image types] test] < 0} {
puts "This application hasn't been compiled with the \"test\" image"
puts "type, so I can't run this test. Are you sure you're using"
puts "tktest instead of wish?"
+ ::tcltest::cleanupTests
return
}
-if {[info procs test] != "test"} {
- source defs
-}
-
proc deleteWindows {} {
foreach i [winfo children .] {
catch [destroy $i]
@@ -45,23 +31,23 @@ deleteWindows
wm geometry . {}
raise .
-test winMenu-1.1 {GetNewID} {
+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} {
+test winMenu-2.1 {FreeID} {pcOnly} {
catch {destroy .m1}
menu .m1
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test winMenu-3.1 {TkpNewMenu} {
+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} {
+test winMenu-3.2 {TkpNewMenu} {pcOnly} {
catch {destroy .m1}
. configure -menu ""
menu .m1
@@ -69,12 +55,12 @@ test winMenu-3.2 {TkpNewMenu} {
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [catch {destroy .m1} msg2] $msg2
} {0 {} {} 0 {}}
-test winMenu-4.1 {TkpDestroyMenu} {
+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} {
+test winMenu-4.2 {TkpDestroyMenu - help menu} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add cascade -menu .m1.system
@@ -82,7 +68,7 @@ test winMenu-4.2 {TkpDestroyMenu - help menu} {
list [catch {destroy .m1.system} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test winMenu-5.1 {TkpDestroyMenuEntry} {
+test winMenu-5.1 {TkpDestroyMenuEntry} {pcOnly} {
catch {destroy .m1}
. configure -menu ""
menu .m1
@@ -91,89 +77,89 @@ test winMenu-5.1 {TkpDestroyMenuEntry} {
list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test winMenu-6.1 {GetEntryText} {
+test winMenu-6.1 {GetEntryText} {pcOnly} {
catch {destroy .m1}
list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
-test winMenu-6.2 {GetEntryText} {
+test winMenu-6.2 {GetEntryText} {pcOnly} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
image create test image1
list [catch {.m1 add command -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
-test winMenu-6.3 {GetEntryText} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add cascade -menu .m1.system
@@ -183,7 +169,7 @@ test winMenu-7.1 {ReconfigureWindowsMenu - system menu item removal} {
.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} {
+test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label Hello
@@ -191,77 +177,77 @@ test winMenu-7.2 {ReconfigureWindowsMenu - menu item removal} {
.m1 add command -label foo
list [catch {update idletasks} msg] $msg [destroy .m1]
} {0 {} {}}
-test winMenu-7.3 {ReconfigureWindowsMenu - zero items} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {pcOnly} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1 -tearoff 0
@@ -269,7 +255,7 @@ test winMenu-7.14 {ReconfigureWindowsMenu - cascade} {
.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} {
+test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add cascade -menu .m1.file
@@ -277,7 +263,7 @@ test winMenu-7.15 {ReconfigureWindowsMenu - menubar without system menu} {
. configure -menu .m1
list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {
+test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add cascade -menu .m1.system
@@ -287,7 +273,7 @@ test winMenu-7.16 {ReconfigureWindowsMenu - system menu already created} {
.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} {
+test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add cascade -menu .m1.system
@@ -295,7 +281,7 @@ test winMenu-7.17 {ReconfigureWindowsMenu - system menu update pending} {
. configure -menu .m1
list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {
+test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add cascade -menu .m1.system
@@ -305,7 +291,7 @@ test winMenu-7.18 {ReconfigureWindowsMenu - system menu update not pending} {
. configure -menu .m1
list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test winMenu-7.19 {ReconfigureWindowsMenu - column break} {
+test winMenu-7.19 {ReconfigureWindowsMenu - column break} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add command -label one
@@ -314,23 +300,23 @@ test winMenu-7.19 {ReconfigureWindowsMenu - column break} {
} {0 {} {}}
#Don't know how to generate nested post menus
-test winMenu-8.1 {TkpPostMenu} {
+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} {
+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} {menuInteractive} {
+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} {menuInteractive} {
+test winMenu-8.4 {TkpPostMenu - menu button} {pcOnly userInteraction} {
catch {destroy .mb}
menubutton .mb -text test -menu .mb.menu
menu .mb.menu
@@ -338,7 +324,7 @@ test winMenu-8.4 {TkpPostMenu - menu button} {menuInteractive} {
pack .mb
list [tkMbPost .mb] [destroy .m1]
} {{} {}}
-test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} {
+test winMenu-8.5 {TkpPostMenu - update not pending} {pcOnly userInteraction} {
catch {destroy .m1}
menu .m1
.m1 add command -label "winMenu-8.5 - Hit ESCAPE."
@@ -346,13 +332,13 @@ test winMenu-8.5 {TkpPostMenu - update not pending} {menuInteractive} {
list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}
-test winMenu-9.1 {TkpMenuNewEntry} {
+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} {menuInteractive} {
+test winMenu-10.1 {TkwinMenuProc} {pcOnly userInteraction} {
catch {destroy .m1}
menu .m1
.m1 add command -label "winMenu-10.1: Hit ESCAPE."
@@ -360,46 +346,63 @@ test winMenu-10.1 {TkwinMenuProc} {menuInteractive} {
} {{} {}}
# Can't generate a WM_INITMENU without a Tk menu yet.
-test winMenu-11.1 {TkWinHandleMenuEvent - WM_INITMENU} {menuInteractive} {
+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} {menuInteractive} {
+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.3 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} {
+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.4 {TkWinHandleMenuEvent - WM_MEASUREITEM} {menuInteractive} {
+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.5 {TkWinHandleMenuEvent - WM_DRAWITEM} {menuInteractive} {
+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.6 {TkWinHandleMenuEvent - WM_DRAWITEM - item disabled} {menuInteractive} {
+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.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuInteractive} {
+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"
@@ -407,14 +410,14 @@ test winMenu-11.7 {TkWinHandleMenuEvent - WM_INITMENU - not pending} {menuIntera
list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
} {0 {} {}}
-test winMenu-12.1 {TkpSetWindowMenuBar} {
+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} {
+test winMenu-12.2 {TkpSetWindowMenuBar} {pcOnly} {
catch {destroy .m1}
. configure -menu ""
menu .m1
@@ -422,7 +425,7 @@ test winMenu-12.2 {TkpSetWindowMenuBar} {
. configure -menu .m1
list [catch {. configure -menu ""} msg] $msg [catch {destroy .m1} msg2] $msg2
} {0 {} 0 {}}
-test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {
+test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {pcOnly} {
catch {destroy .m1}
. configure -menu ""
menu .m1 -tearoff 0
@@ -431,48 +434,48 @@ test winMenu-12.3 {TkpSetWindowMenuBar - no update pending} {
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {} {}
+test winMenu-13.1 {TkpSetMainMenubar - nothing to do} {emptyTest pcOnly} {} {}
-test winMenu-14.1 {GetMenuIndicatorGeometry} {
+test winMenu-14.1 {GetMenuIndicatorGeometry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo
list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
-test winMenu-14.2 {GetMenuIndicatorGeometry} {
+test winMenu-14.2 {GetMenuIndicatorGeometry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo -hidemargin 1
list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
-test winMenu-15.1 {GetMenuAccelGeometry} {
+test winMenu-15.1 {GetMenuAccelGeometry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add cascade -label foo -accel Ctrl+U
list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
-test winMenu-15.2 {GetMenuAccelGeometry} {
+test winMenu-15.2 {GetMenuAccelGeometry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
-test winMenu-15.3 {GetMenuAccelGeometry} {
+test winMenu-15.3 {GetMenuAccelGeometry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -accel "Ctrl+U"
list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
} {0 {}}
-test winMenu-16.1 {GetTearoffEntryGeometry} {menuInteractive} {
+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} {
+test winMenu-17.1 {GetMenuSeparatorGeometry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add separator
@@ -481,7 +484,7 @@ test winMenu-17.1 {GetMenuSeparatorGeometry} {
# Currently, the only callers to DrawWindowsSystemBitmap want things
# centered vertically, and either centered or right aligned horizontally.
-test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {
+test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo
@@ -489,7 +492,7 @@ test winMenu-18.1 {DrawWindowsSystemBitmap - center aligned} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {
+test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add cascade -label foo
@@ -497,21 +500,22 @@ test winMenu-18.2 {DrawWindowsSystemBitmap - right aligned} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} {
+test winMenu-19.1 {DrawMenuEntryIndicator - not checkbutton or radiobutton} \
+ {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {
+test winMenu-19.2 {DrawMenuEntryIndicator - not selected} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {
+test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo
@@ -519,7 +523,7 @@ test winMenu-19.3 {DrawMenuEntryIndicator - checkbutton} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {
+test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add radiobutton -label foo
@@ -527,7 +531,7 @@ test winMenu-19.4 {DrawMenuEntryIndicator - radiobutton} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {
+test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo
@@ -536,7 +540,7 @@ test winMenu-19.5 {DrawMenuEntryIndicator - disabled} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {
+test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo -indicatoron 0
@@ -545,42 +549,44 @@ test winMenu-19.6 {DrawMenuEntryIndicator - indicator not on} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {
+test winMenu-20.1 {DrawMenuEntryAccelerator - disabled} {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground red
.m1 add command -label foo -accel "Ctrl+U" -state disabled
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {
+test winMenu-20.2 {DrawMenuEntryAccelerator - normal text} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -accel "Ctrl+U"
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} {
+test winMenu-20.3 {DrawMenuEntryAccelerator - disabled, no disabledforeground} \
+ {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground ""
.m1 add command -label foo -accel "Ctrl+U" -state disabled
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {
+test winMenu-20.4 {DrawMenuEntryAccelerator - cascade, drawArrow true} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add cascade -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-20.5 {DrawMenuEntryAccelerator - cascade, drawArrow false} {menuInteractive} {
+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} {
+test winMenu-21.1 {DrawMenuSeparator} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add separator
@@ -588,7 +594,7 @@ test winMenu-21.1 {DrawMenuSeparator} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-22.1 {DrawMenuUnderline} {
+test winMenu-22.1 {DrawMenuUnderline} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -underline 0
@@ -596,24 +602,26 @@ test winMenu-22.1 {DrawMenuUnderline} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-23.1 {Don't know how to test MenuKeyBindProc} {} {}
-test winMenu-24.1 {TkpInitializeMenuBindings called at boot time} {} {}
+test winMenu-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} {
+test winMenu-25.1 {DrawMenuEntryLabel - normal} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {
+test winMenu-25.2 {DrawMenuEntryLabel - disabled with fg} {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground red
.m1 add command -label foo -state disabled
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {
+test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground ""
.m1 add command -label foo -state disabled
@@ -621,27 +629,27 @@ test winMenu-25.3 {DrawMenuEntryLabel - disabled with no fg} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-26.1 {TkpComputeMenubarGeometry} {
+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} {menuInteractive} {
+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} {
+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} {
+test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add command -label One
@@ -649,7 +657,8 @@ test winMenu-28.2 {TkpConfigureMenuEntry - update not pending} {
list [catch {.m1 add command -label Two} msg] $msg [destroy .m1]
} {0 {} {}}
-test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} {
+test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} \
+ {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
@@ -657,7 +666,8 @@ test winMenu-29.1 {TkpDrawMenuEntry - gc for active and not strict motif} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {
+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
@@ -665,7 +675,7 @@ test winMenu-29.2 {TkpDrawMenuEntry - gc for active menu item with its own gc} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {
+test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {pcOnly} {
catch {destroy .m1}
menu .m1
set tk_strictMotif 1
@@ -674,42 +684,44 @@ test winMenu-29.3 {TkpDrawMenuEntry - gc for active and strict motif} {
.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} {
+test winMenu-29.4 \
+ {TkpDrawMenuEntry - gc for disabled with disabledfg and custom entry} \
+ {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground blue
.m1 add command -label foo -state disabled -background red
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {
+test winMenu-29.5 {TkpDrawMenuEntry - gc for disabled with disabledFg} {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground blue
.m1 add command -label foo -state disabled
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {
+test winMenu-29.6 {TkpDrawMenuEntry - gc for disabled - no disabledFg} {pcOnly} {
catch {destroy .m1}
menu .m1 -disabledforeground ""
.m1 add command -label foo -state disabled
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {
+test winMenu-29.7 {TkpDrawMenuEntry - gc for normal - custom entry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -foreground red
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {
+test winMenu-29.8 {TkpDrawMenuEntry - gc for normal} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {
+test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo -selectcolor orange
@@ -717,7 +729,7 @@ test winMenu-29.9 {TkpDrawMenuEntry - gc for indicator - custom entry} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {
+test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label foo
@@ -725,7 +737,7 @@ test winMenu-29.10 {TkpDrawMenuEntry - gc for indicator} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {
+test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -activebackground green
@@ -733,7 +745,7 @@ test winMenu-29.11 {TkpDrawMenuEntry - border - custom entry} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.12 {TkpDrawMenuEntry - border} {
+test winMenu-29.12 {TkpDrawMenuEntry - border} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
@@ -741,7 +753,7 @@ test winMenu-29.12 {TkpDrawMenuEntry - border} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {
+test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {pcOnly} {
catch {destroy .m1}
set tk_strictMotif 1
menu .m1
@@ -750,7 +762,7 @@ test winMenu-29.13 {TkpDrawMenuEntry - active border - strict motif} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1] [set tk_strictMotif 0]
} {{} {} 0}
-test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {
+test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -activeforeground yellow
@@ -758,7 +770,7 @@ test winMenu-29.14 {TkpDrawMenuEntry - active border - custom entry} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.15 {TkpDrawMenuEntry - active border} {
+test winMenu-29.15 {TkpDrawMenuEntry - active border} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
@@ -766,35 +778,35 @@ test winMenu-29.15 {TkpDrawMenuEntry - active border} {
.m1 entryconfigure 1 -state active
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {
+test winMenu-29.16 {TkpDrawMenuEntry - font - custom entry} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo -font "Helvectica 72"
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.17 {TkpDrawMenuEntry - font} {
+test winMenu-29.17 {TkpDrawMenuEntry - font} {pcOnly} {
catch {destroy .m1}
menu .m1 -font "Courier 72"
.m1 add command -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.18 {TkpDrawMenuEntry - separator} {
+test winMenu-29.18 {TkpDrawMenuEntry - separator} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add separator
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.19 {TkpDrawMenuEntry - standard} {
+test winMenu-29.19 {TkpDrawMenuEntry - standard} {pcOnly} {
catch {destroy .mb}
menu .m1
.m1 add command -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {
+test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add cascade -label File -menu .m1.file
@@ -804,7 +816,7 @@ test winMenu-29.20 {TkpDrawMenuEntry - disabled cascade item} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.21 {TkpDrawMenuEntry - indicator} {
+test winMenu-29.21 {TkpDrawMenuEntry - indicator} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label winMenu-31.20
@@ -812,7 +824,7 @@ test winMenu-29.21 {TkpDrawMenuEntry - indicator} {
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-29.22 {TkpDrawMenuEntry - indicator} {
+test winMenu-29.22 {TkpDrawMenuEntry - indicator} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton -label winMenu-31.21 -hidemargin 1
@@ -821,7 +833,7 @@ test winMenu-29.22 {TkpDrawMenuEntry - indicator} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-30.1 {GetMenuLabelGeometry - image} {
+test winMenu-30.1 {GetMenuLabelGeometry - image} {pcOnly} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -829,33 +841,33 @@ test winMenu-30.1 {GetMenuLabelGeometry - image} {
.m1 add command -image image1
list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
-test winMenu-30.2 {GetMenuLabelGeometry - bitmap} {
+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} {
+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} {
+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} {
+test winMenu-31.1 {DrawMenuEntryBackground} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
set tearoff [tkTearOffMenu .m1 40 40]
list [update] [destroy .m1]
} {{} {}}
-test winMenu-31.2 {DrawMenuEntryBackground} {
+test winMenu-31.2 {DrawMenuEntryBackground} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label foo
@@ -864,25 +876,25 @@ test winMenu-31.2 {DrawMenuEntryBackground} {
list [update] [destroy .m1]
} {{} {}}
-test winMenu-32.1 {TkpComputeStandardMenuGeometry - no entries} {
+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} {
+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} {
+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} {
+test winMenu-32.4 {TkpComputeStandardMenuGeometry - separator} {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add separator
@@ -897,60 +909,65 @@ test winMenu-32.5 {TkpComputeStandardMenuGeometry - tearoff entry} {unixOnly} {
catch {tkMbPost .mb}
list [update] [destroy .mb]
} {{} {}}
-test winMenu-32.6 {TkpComputeStandardMenuGeometry - standard label geometry} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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} {
+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 } {
+test winMenu-32.14 \
+ {TkpComputeStandardMenuGeometry - second indicator less or equal} \
+ {pcOnly} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
@@ -961,7 +978,8 @@ test winMenu-32.14 {TkpComputeStandardMenuGeometry - second indicator less or eq
.m1 invoke 2
list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
-test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } {unixOnly} {
+test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger} \
+ {unixOnly} {
catch {destroy .m1}
catch {image delete image1}
image create test image1
@@ -972,12 +990,14 @@ test winMenu-32.15 {TkpComputeStandardMenuGeometry - second indicator larger } {
.m1 invoke 2
list [update idletasks] [destroy .m1] [image delete image1]
} {{} {} {}}
-test winMenu-32.16 {TkpComputeStandardMenuGeometry - zero sized menus} {
+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} {
+test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} \
+ {pcOnly} {
catch {destroy .m1}
menu .m1
.m1 add command -label one
@@ -985,7 +1005,8 @@ test winMenu-32.17 {TkpComputeStandardMenuGeometry - first column bigger} {
.m1 add command -label three -columnbreak 1
list [update idletasks] [destroy .m1]
} {{} {}}
-test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} {
+test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} \
+ {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add command -label one
@@ -993,7 +1014,7 @@ test winMenu-32.18 {TkpComputeStandardMenuGeometry - second column bigger} {
.m1 add command -label three
list [update idletasks] [destroy .m1]
} {{} {}}
-test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {
+test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {pcOnly} {
catch {destroy .m1}
menu .m1 -tearoff 0
.m1 add command -label one
@@ -1005,14 +1026,14 @@ test winMenu-32.19 {TkpComputeStandardMenuGeometry - three columns} {
list [update idletasks] [destroy .m1]
} {{} {}}
-test winMenu-33.1 {TkpNotifyTopLevelCreate - no menu yet} {
+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} {
+test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {pcOnly} {
catch {destroy .t2}
catch {destroy .m1}
menu .m1
@@ -1025,6 +1046,21 @@ test winMenu-33.2 {TkpNotifyTopLevelCreate - menu} {
list [update idletasks] [destroy .m1] [destroy .t2]
} {{} {} {}}
-test winMenu-34.1 {TkpMenuInit called at boot time} {} {}
+test winMenu-34.1 {TkpMenuInit called at boot time} {emptyTest pcOnly} {} {}
+# cleanup
deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/winSend.test b/tk/tests/winSend.test
new file mode 100644
index 00000000000..54cec4ce8ff
--- /dev/null
+++ b/tk/tests/winSend.test
@@ -0,0 +1,428 @@
+# This file is a Tcl script to test out the "send" command and the
+# other procedures in the file tkSend.c. It is organized in the
+# standard fashion for Tcl tests.
+#
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {$tcl_platform(platform) != "windows"} {
+ puts "skipping: Windows only tests..."
+ ::tcltest::cleanupTests
+ return
+}
+
+if {[info commands send] != "send"} {
+ puts "skipping: Unimplemented send command"
+ ::tcltest::cleanupTests
+ return
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+set currentInterps [winfo interps]
+
+if {[catch {exec tktest &}] == 1} {
+ puts "Could not run winSend.test because another instance of tktest could not be loaded."
+ ::tcltest::cleanupTests
+ return;
+}
+
+# Compute a script that will load Tk into a child interpreter.
+
+foreach pkg [info loaded] {
+ if {[lindex $pkg 1] == "Tk"} {
+ set loadTk "load $pkg"
+ break
+ }
+}
+
+# Procedure to create a new application with a given name and class.
+
+proc newApp {name {safe {}}} {
+ global loadTk
+ if {[string compare $safe "-safe"] == 0} {
+ interp create -safe $name
+ } else {
+ interp create $name
+ }
+ $name eval [list set argv [list -name $name]]
+ catch {eval $loadTk $name}
+}
+
+# Wait until the child application has launched.
+
+while {[llength [winfo interps]] == [llength $currentInterps]} {
+}
+
+# Now find an interp to send to
+set newInterps [winfo interps]
+foreach interp $newInterps {
+ if {[lsearch -exact $currentInterps $interp] < 0} {
+ break
+ }
+}
+
+# Now we have found our interpreter we are going to send to. Make sure that
+# it works first.
+if {[catch {send $interp {console hide; update}}] == 1} {
+ puts "Could not send to child interpreter $interp"
+ ::tcltest::cleanupTests
+ return
+}
+
+# setting up dde server is done when the first interp is created and
+# cannot be tested very easily.
+test winSend-1.1 {Tk_SetAppName - changing name of interp} {
+ newApp testApp
+ list [testApp eval tk appname testApp2] [interp delete testApp]
+} {testApp2 {}}
+test winSend-1.2 {Tk_SetAppName - changing name - not front of linked list} {
+ newApp testApp
+ newApp testApp2
+ list [testApp eval tk appname testApp3] [interp delete testApp] [interp delete testApp2]
+} {testApp3 {} {}}
+test winSend-1.3 {Tk_SetAppName - unique name - no conflicts} {
+ newApp testApp
+ list [testApp eval tk appname testApp] [interp delete testApp]
+} {testApp {}}
+test winSend-1.4 {Tk_SetAppName - unique name - one conflict} {
+ newApp testApp
+ newApp foobar
+ list [foobar eval tk appname testApp] [interp delete foobar] [interp delete testApp]
+} {{testApp #2} {} {}}
+test winSend-1.5 {Tk_SetAppName - unique name - one conflict} {
+ newApp testApp
+ newApp foobar
+ newApp blaz
+ foobar eval tk appname testApp
+ list [blaz eval tk appname testApp] [interp delete foobar] [interp delete testApp] [interp delete blaz]
+} {{testApp #3} {} {} {}}
+test winSend-1.6 {Tk_SetAppName - safe interps} {
+ newApp testApp -safe
+ list [catch {testApp eval send testApp {set foo a}} msg] $msg [interp delete testApp]
+} {1 {invalid command name "send"} {}}
+
+test winSend-2.1 {Tk_SendObjCmd - # of args} {
+ list [catch {send tktest} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+ list [catch {send -bogus tktest} msg] $msg
+} {1 {bad option "-bogus": must be -async, -displayof, or --}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+ list [catch {send -async bogus foo} msg] $msg
+} {1 {no registered server named "bogus"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+ list [catch {send -displayof . bogus foo} msg] $msg
+} {1 {no registered server named "bogus"}}
+test winSend-2.1 {Tk_SendObjCmd: arguments} {
+ list [catch {send -- -bogus foo} msg] $msg
+} {1 {no registered server named "-bogus"}}
+test winSend-2.2 {Tk_SendObjCmd - sending to ourselves} {
+ list [send [tk appname] {set foo a}]
+} {a}
+test winSend-2.3 {Tk_SendObjCmd - sending to ourselves in a different interpreter} {
+ newApp testApp
+ list [catch {send testApp {set foo b}} msg] $msg [interp delete testApp]
+} {0 b {}}
+test winSend-2.4 {Tk_SendObjCmd - sending to ourselves in a different interp with errors} {
+ newApp testApp
+ list [catch {send testApp {expr 2 / 0}} msg] $msg $errorCode $errorInfo [interp delete testApp]
+} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send testApp {expr 2 / 0}\"} {}"
+test winSend-2.5 {Tk_SendObjCmd - sending to another app async} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send -async $interp {set foo a}} msg] $msg
+} {0 {}}
+test winSend-2.6 {Tk_SendObjCmd - sending to another app sync - no error} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send $interp {set foo a}} msg] $msg
+} {0 a}
+test winSend-2.7 {Tk_SendObjCmd - sending to another app - error} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send $interp {expr 2 / 0}} msg] $msg $errorCode $errorInfo
+} "1 {divide by zero} {ARITH DIVZERO {divide by zero}} {divide by zero\n while executing\n\"expr 2 / 0\"\n invoked from within\n\"send \$interp {expr 2 / 0}\"}"
+
+test winSend-3.1 {TkGetInterpNames} {
+ set origLength [llength $currentInterps]
+ set newLength [llength [winfo interps]]
+ expr {($newLength - 2) == $origLength}
+} {1}
+
+test winSend-4.1 {DeleteProc - changing name of app} {
+ newApp a
+ list [a eval tk appname foo] [interp delete a]
+} {foo {}}
+test winSend-4.2 {DeleteProc - normal} {
+ newApp a
+ list [interp delete a]
+} {{}}
+
+test winSend-5.1 {ExecuteRemoteObject - no error} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [send $interp {send [tk appname] {expr 2 / 1}}]
+} {2}
+test winSend-5.2 {ExecuteRemoteObject - error} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {send $interp {send [tk appname] {expr 2 / 0}}} msg] $msg
+} {1 {divide by zero}}
+
+test winSend-6.1 {SendDDEServer - XTYP_CONNECT} {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.2 {SendDDEServer - XTYP_CONNECT_CONFIRM} {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.3 {SendDDEServer - XTYP_DISCONNECT} {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.4 {SendDDEServer - XTYP_REQUEST variable} {
+ set foo "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 {Hello, World}}
+test winSend-6.5 {SendDDEServer - XTYP_REQUEST array} {
+ catch {unset foo}
+ set foo(test) "Hello, World"
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde request Tk [tk appname] foo(test)"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg [catch {unset foo}]
+} {0 {Hello, World} 0}
+test winSend-6.6 {SendDDEServer - XTYP_REQUEST return results} {
+ set foo 3
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "send [tk appname] {expr $foo + 1}"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 4}
+test winSend-6.7 {SendDDEServer - XTYP_EXECUTE} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "send [tk appname] {expr 4 / 2}"
+ list [catch "send \{$interp\} \{$command\}" msg] $msg
+} {0 2}
+test winSend-6.8 {SendDDEServer - XTYP_WILDCONNECT} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ set command "dde services Tk {}"
+ list [catch "send \{$interp\} \{$command\}"]
+} {0}
+
+test winSend-7.1 {DDEExitProc} {
+ newApp testApp
+ list [interp delete testApp]
+} {{}}
+
+test winSend-8.1 {SendDdeConnect} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [send $interp {set tk foo}]
+} {foo}
+
+test winSend-9.1 {SetDDEError} {
+ list [catch {dde execute Tk foo {set foo hello}} msg] $msg
+} {1 {dde command failed}}
+
+test winSend-10.1 {Tk_DDEObjCmd - wrong num args} {
+ list [catch {dde} msg] $msg
+} {1 {wrong # args: should be "dde ?-async? serviceName topicName value"}}
+test winSend-10.2 {Tk_DDEObjCmd - unknown subcommand} {
+ list [catch {dde foo} msg] $msg
+} {1 {bad command "foo": must be execute, request, or services}}
+test winSend-10.3 {Tk_DDEObjCmd - execute - wrong num args} {
+ list [catch {dde execute} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.4 {Tk_DDEObjCmd - execute - wrong num args} {
+ list [catch {dde execute 3 4 5 6 7} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.5 {Tk_DDEObjCmd - execute async - wrong num args} {
+ list [catch {dde execute -async} msg] $msg
+} {1 {wrong # args: should be "dde execute ?-async? serviceName topicName value"}}
+test winSend-10.6 {Tk_DDEObjCmd - request - wrong num args} {
+ list [catch {dde request} msg] $msg
+} {1 {wrong # args: should be "dde request serviceName topicName value"}}
+test winSend-10.7 {Tk_DDEObjCmd - services wrong num args} {
+ list [catch {dde services} msg] $msg
+} {1 {wrong # args: should be "dde services serviceName topicName"}}
+test winSend-10.8 {Tk_DDEObjCmd - null service name} {
+ list [catch {dde services {} {tktest #2}}]
+} {0}
+test winSend-10.9 {Tk_DDEObjCmd - null topic name} {
+ list [catch {dde services {Tk} {}}]
+} {0}
+test winSend-10.10 {Tk_DDEObjCmd - execute - nothing to execute} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde execute Tk $interp {}} msg] $msg
+} {1 {cannot execute null data}}
+test winSend-10.11 {Tk_DDEObjCmd - execute - no such conversation} {
+ list [catch {dde execute Tk foo {set foo hello}} msg] $msg
+} {1 {dde command failed}}
+test winSend-10.12 {Tk_DDEObjCmd - execute - async} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde execute -async Tk $interp {set foo hello}} msg] $msg
+} {0 {}}
+test winSend-10.13 {Tk_DDEObjCmd - execute} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde execute Tk $interp {set foo goodbye}} msg] $msg
+} {0 {}}
+test winSend-10.14 {Tk_DDEObjCmd - request - nothing to request} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde request Tk $interp {}} msg] $msg
+} {1 {cannot request value of null data}}
+test winSend-10.15 {Tk_DDEObjCmd - request - invalid interp} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ list [catch {dde request Tk foo foo} msg] $msg
+} {1 {dde command failed}}
+test winSend-10.16 {Tk_DDEObjCmd - invalid variable} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ send $interp {unset foo}
+ list [catch {dde request Tk $interp foo} msg] $msg
+} {1 {remote server cannot handle this command}}
+test winSend-10.17 {Tk_DDEObjCmd - valid variable} {
+ set newInterps [winfo interps]
+ foreach interp $newInterps {
+ if {[lsearch $currentInterps $interp] < 0} {
+ break
+ }
+ }
+ send $interp {set foo winSend-10.17}
+ list [catch {dde request Tk $interp foo} msg] $msg
+} {0 winSend-10.17}
+test winSend-10.18 {Tk_DDEObjCmd - services} {
+ set currentService [list Tk [tk appname]]
+ list [catch {dde services Tk {}} msg] [expr [lsearch $msg $currentService] >= 0]
+} {0 1}
+
+# Get rid of the other app and all of its interps
+
+set newInterps [winfo interps]
+while {[llength $newInterps] != [llength $currentInterps]} {
+ foreach interp $newInterps {
+ if {[lsearch -exact $currentInterps $interp] < 0} {
+ catch {send $interp exit}
+ set newInterps [winfo interps]
+ break
+ }
+ }
+}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/winWm.test b/tk/tests/winWm.test
index abe478eba2c..e3d15ea5529 100644
--- a/tk/tests/winWm.test
+++ b/tk/tests/winWm.test
@@ -6,18 +6,13 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {$tcl_platform(platform) != "windows"} {
- return
-}
-
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -41,7 +36,7 @@ update
set menuheight [expr $menuheight - [winfo y .t]]
destroy .t
-test winWm-1.1 {TkWmMapWindow} {
+test winWm-1.1 {TkWmMapWindow} {pcOnly} {
toplevel .t
wm override .t 1
wm geometry .t +0+0
@@ -50,7 +45,7 @@ test winWm-1.1 {TkWmMapWindow} {
destroy .t
set result
} {0 0}
-test winWm-1.2 {TkWmMapWindow} {
+test winWm-1.2 {TkWmMapWindow} {pcOnly} {
toplevel .t
wm transient .t .
update
@@ -62,7 +57,7 @@ test winWm-1.2 {TkWmMapWindow} {
destroy .t
set msg
} {can't iconify ".t": it is a transient}
-test winWm-1.3 {TkWmMapWindow} {
+test winWm-1.3 {TkWmMapWindow} {pcOnly} {
toplevel .t
update
toplevel .t2
@@ -71,7 +66,7 @@ test winWm-1.3 {TkWmMapWindow} {
destroy .t .t2
set result
} 1
-test winWm-1.4 {TkWmMapWindow} {
+test winWm-1.4 {TkWmMapWindow} {pcOnly} {
toplevel .t
wm geometry .t +10+10
update
@@ -82,7 +77,7 @@ test winWm-1.4 {TkWmMapWindow} {
destroy .t .t2
set result
} {10 40}
-test winWm-1.5 {TkWmMapWindow} {
+test winWm-1.5 {TkWmMapWindow} {pcOnly} {
toplevel .t
wm iconify .t
update
@@ -91,7 +86,7 @@ test winWm-1.5 {TkWmMapWindow} {
set result
} iconic
-test winWm-2.1 {TkpWmSetState} {
+test winWm-2.1 {TkpWmSetState} {pcOnly} {
toplevel .t
wm geometry .t 150x50+10+10
update
@@ -105,7 +100,7 @@ test winWm-2.1 {TkpWmSetState} {
destroy .t
set result
} {normal iconic normal}
-test winWm-2.2 {TkpWmSetState} {
+test winWm-2.2 {TkpWmSetState} {pcOnly} {
toplevel .t
wm geometry .t 150x50+10+10
update
@@ -122,7 +117,24 @@ test winWm-2.2 {TkpWmSetState} {
destroy .t
set result
} {normal withdrawn iconic normal}
-test winWm-2.3 {TkpWmSetState} {
+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
@@ -141,8 +153,7 @@ test winWm-2.3 {TkpWmSetState} {
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} {
+test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {pcOnly} {
toplevel .t
wm geometry .t +0+0
button .t.b
@@ -161,7 +172,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} {
set x
} 1
-test winWm-4.1 {ConfigureTopLevel: menu resizing} {
+test winWm-4.1 {ConfigureTopLevel: menu resizing} {pcOnly} {
set result {}
toplevel .t
frame .t.f -width 150 -height 50 -bg red
@@ -178,7 +189,7 @@ test winWm-4.1 {ConfigureTopLevel: menu resizing} {
set result
} [expr $menuheight + 1]
-test winWm-5.1 {UpdateGeometryInfo: menu resizing} {
+test winWm-5.1 {UpdateGeometryInfo: menu resizing} {pcOnly} {
set result {}
toplevel .t
frame .t.f -width 150 -height 50 -bg red
@@ -197,7 +208,7 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} {
destroy .t
set result
} {50 50 50}
-test winWm-5.2 {UpdateGeometryInfo: menu resizing} {
+test winWm-5.2 {UpdateGeometryInfo: menu resizing} {pcOnly} {
set result {}
toplevel .t
frame .t.f -width 150 -height 50 -bg red
@@ -217,3 +228,19 @@ test winWm-5.2 {UpdateGeometryInfo: menu resizing} {
destroy .t
set result
} {50 50 0}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/window.test b/tk/tests/window.test
index fca332f2cb4..6d9371ba14d 100644
--- a/tk/tests/window.test
+++ b/tk/tests/window.test
@@ -2,14 +2,13 @@
# tkWindow.c. It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -80,13 +79,12 @@ test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
destroy .f
} {}
-if {[string compare testmenubar [info commands testmenubar]] != 0} {
- puts "This application hasn't been compiled with the testmenubar command,"
- puts "therefore I am skipping all of these tests."
- return
-}
+# Some tests require the testmenubar command
+set ::tcltest::testConfig(testmenubar) \
+ [expr {[info commands testmenubar] != {}}]
-test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
+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
@@ -96,7 +94,8 @@ test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unix
update
# If stacking order isn't handle properly, generates an X error.
} {}
-test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
+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
@@ -110,11 +109,11 @@ test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unix
# If stacking order isn't handled properly, generates an X error.
} {}
-test window-4.1 {Tk_NameToWindow procedure} {
+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} {
+test window-4.2 {Tk_NameToWindow procedure} {testmenubar} {
catch {destroy .t}
frame .t -width 100 -height 50
place .t -x 10 -y 10
@@ -122,7 +121,8 @@ test window-4.2 {Tk_NameToWindow procedure} {
list [catch {winfo geometry .t} msg] $msg
} {0 100x50+10+10}
-test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
+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
@@ -135,3 +135,19 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unix
update
# If stacking order isn't handled properly, generates an X error.
} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/tests/winfo.test b/tk/tests/winfo.test
index f2cb6250119..12af58b4f6f 100644
--- a/tk/tests/winfo.test
+++ b/tk/tests/winfo.test
@@ -3,14 +3,13 @@
#
# 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.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
foreach i [winfo children .] {
@@ -19,6 +18,10 @@ foreach i [winfo children .] {
wm geometry . {}
raise .
+# Some tests require the testwrapper command
+set ::tcltest::testConfig(testwrapper) \
+ [expr {[info commands testwrapper] != {}}]
+
# eatColors --
# Creates a toplevel window and allocates enough colors in it to
# use up all the slots in the colormap.
@@ -88,32 +91,33 @@ test winfo-2.7 {"winfo atom" command} {
winfo atomname -displayof . 2
} SECONDARY
-if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} {
- test winfo-3.1 {"winfo colormapfull" command} {
- list [catch {winfo colormapfull} msg] $msg
- } {1 {wrong # args: should be "winfo colormapfull window"}}
- test winfo-3.2 {"winfo colormapfull" command} {
- list [catch {winfo colormapfull a b} msg] $msg
- } {1 {wrong # args: should be "winfo colormapfull window"}}
- test winfo-3.3 {"winfo colormapfull" command} {
- list [catch {winfo colormapfull foo} msg] $msg
- } {1 {bad window path name "foo"}}
- test winfo-3.4 {"winfo colormapfull" command} {macOrUnix} {
- eatColors .t {-colormap new}
- set result [list [winfo colormapfull .] [winfo colormapfull .t]]
- .t.c delete 34
- lappend result [winfo colormapfull .t]
- .t.c create rectangle 30 30 80 80 -fill #441739
- lappend result [winfo colormapfull .t]
- .t.c create rectangle 40 40 90 90 -fill #ffeedd
- lappend result [winfo colormapfull .t]
- destroy .t.c
- lappend result [winfo colormapfull .t]
- } {0 1 0 0 1 0}
- catch {destroy .t}
-}
+# Some tests require the "pseudocolor" visual class.
+set ::tcltest::testConfig(pseudocolor) \
+ [expr {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")}]
+test winfo-3.1 {"winfo colormapfull" command} {pseudocolor} {
+ list [catch {winfo colormapfull} msg] $msg
+} {1 {wrong # args: should be "winfo colormapfull window"}}
+test winfo-3.2 {"winfo colormapfull" command} {pseudocolor} {
+ list [catch {winfo colormapfull a b} msg] $msg
+} {1 {wrong # args: should be "winfo colormapfull window"}}
+test winfo-3.3 {"winfo colormapfull" command} {pseudocolor} {
+ list [catch {winfo colormapfull foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test winfo-3.4 {"winfo colormapfull" command} {macOrUnix pseudocolor} {
+ eatColors .t {-colormap new}
+ set result [list [winfo colormapfull .] [winfo colormapfull .t]]
+ .t.c delete 34
+ lappend result [winfo colormapfull .t]
+ .t.c create rectangle 30 30 80 80 -fill #441739
+ lappend result [winfo colormapfull .t]
+ .t.c create rectangle 40 40 90 90 -fill #ffeedd
+ lappend result [winfo colormapfull .t]
+ destroy .t.c
+ lappend result [winfo colormapfull .t]
+} {0 1 0 0 1 0}
catch {destroy .t}
+
toplevel .t -width 550 -height 400
frame .t.f -width 80 -height 60 -bd 2 -relief raised
place .t.f -x 50 -y 50
@@ -206,15 +210,9 @@ test winfo-7.6 {"winfo pathname" command} {
test winfo-7.7 {"winfo pathname" command} {
winfo pathname -displayof .b [winfo id .]
} {.}
-
-if {[string compare testwrapper [info commands testwrapper]] == 0} {
- puts "This application hasn't been compiled with the testwrapper command,"
- puts "therefore I am skipping all of these tests."
-
- test winfo-7.8 {"winfo pathname" command} {unixOnly} {
- winfo pathname [testwrapper .]
- } {}
-}
+test winfo-7.8 {"winfo pathname" command} {unixOnly testwrapper} {
+ winfo pathname [testwrapper .]
+} {}
test winfo-8.1 {"winfo pointerx" command} {
catch [winfo pointerx .b]
@@ -317,7 +315,7 @@ proc MakeEmbed {} {
pack .emb.b -expand yes -fill both
update
}
-test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
+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]]
@@ -325,8 +323,8 @@ test winfo-13.1 {root coordinates of embedded toplevel} {macOrUnix} {
destroy .con
set z
} {1}
-test winfo-13.2 {destroying embedded toplevel} {macOrUnix} {
- catch {destroy .emb}
+test winfo-13.2 {destroying embedded toplevel} {
+ destroy .emb
update
expr [winfo exists .emb.b] || [winfo exists .con]
} 0
@@ -335,7 +333,7 @@ foreach i [winfo children .] {
destroy $i
}
-test winfo-13.3 {destroying container window} {macOrUnix} {
+test winfo-13.3 {destroying container window} {
MakeEmbed
destroy .con
update
@@ -349,7 +347,7 @@ foreach i [winfo children .] {
destroy $i
}
-test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
+test winfo-13.4 {[winfo containing] with embedded windows} {
MakeEmbed
button .b
pack .b -expand yes -fill both
@@ -365,3 +363,8 @@ test winfo-13.4 {[winfo containing] with embedded windows} {macOrUnix} {
foreach i [winfo children .] {
catch {destroy $i}
}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
diff --git a/tk/tests/wm.test b/tk/tests/wm.test
new file mode 100644
index 00000000000..e6963548346
--- /dev/null
+++ b/tk/tests/wm.test
@@ -0,0 +1,674 @@
+# 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-1995 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) wm.test 1.31 96/03/01 11:36:58
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+proc sleep ms {
+ global x
+ after $ms {set x 1}
+ tkwait variable x
+}
+
+set i 1
+foreach geom {+20+80 +80+20 +0+0} {
+ catch {destroy .t}
+ test wm-1.$i {initial window position} {
+ toplevel .t -width 200 -height 150
+ wm geom .t $geom
+ update
+ wm geom .t
+ } 200x150$geom
+ incr i
+}
+
+# The tests below are tricky because window managers don't all move
+# windows correctly. Try one motion and compute the window manager's
+# error, then factor this error into the actual tests. In other words,
+# this just makes sure that things are consistent between moves.
+
+set i 1
+catch {destroy .t}
+toplevel .t -width 100 -height 150
+wm geom .t +200+200
+update
+wm geom .t +150+150
+update
+scan [wm geom .t] %dx%d+%d+%d width height x y
+set xerr [expr 150-$x]
+set yerr [expr 150-$y]
+foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
+ test wm-2.$i {moving window while mapped} {
+ wm geom .t $geom
+ update
+ scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
+ format "%s%d%s%d" $xsign [expr $x$xsign$xerr] $ysign \
+ [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 wm-3.$i {moving window while iconified} {
+ wm iconify .t
+ sleep 200
+ wm geom .t $geom
+ update
+ wm deiconify .t
+ scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
+ format "%s%d%s%d" $xsign [expr $x$xsign$xerr] $ysign \
+ [expr $y$ysign$yerr]
+ } $geom
+ incr i
+}
+
+set i 1
+foreach geom {+20+80 +100+40 +0+0} {
+ test wm-4.$i {moving window while withdrawn} {
+ wm withdraw .t
+ sleep 200
+ wm geom .t $geom
+ update
+ wm deiconify .t
+ wm geom .t
+ } 100x150$geom
+ incr i
+}
+
+test wm-5.1 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm withdraw .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+test wm-5.2 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm withdraw .t
+ wm deiconify .t
+ wm withdraw .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 withdrawn}
+test wm-5.3 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm deiconify .t
+ wm iconify .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+test wm-5.4 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm deiconify .t
+ wm iconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 iconic}
+test wm-5.5 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm withdraw .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 withdrawn}
+test wm-5.6 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm withdraw .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+test wm-5.7 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm withdraw .t
+ wm iconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 iconic}
+
+catch {destroy .t}
+toplevel .t -width 200 -height 100
+wm geom .t +10+10
+wm minsize .t 1 1
+update
+test wm-6.1 {size changes} {
+ .t config -width 180 -height 150
+ update
+ wm geom .t
+} 180x150+10+10
+test wm-6.2 {size changes} {
+ wm geom .t 250x60
+ .t config -width 170 -height 140
+ update
+ wm geom .t
+} 250x60+10+10
+test wm-6.3 {size changes} {
+ wm geom .t 250x60
+ .t config -width 170 -height 140
+ wm geom .t {}
+ update
+ wm geom .t
+} 170x140+10+10
+test wm-6.4 {size changes} {nonPortable} {
+ wm minsize .t 1 1
+ update
+ puts stdout "Please resize window \"t\" with the mouse (but don't move it!),"
+ puts -nonewline stdout "then hit return: "
+ flush stdout
+ gets stdin
+ update
+ set width [winfo width .t]
+ set height [winfo height .t]
+ .t config -width 230 -height 110
+ update
+ incr width -[winfo width .t]
+ incr height -[winfo height .t]
+ wm geom .t {}
+ update
+ set w2 [winfo width .t]
+ set h2 [winfo height .t]
+ .t config -width 114 -height 261
+ update
+ list $width $height $w2 $h2 [wm geom .t]
+} {0 0 230 110 114x261+10+10}
+
+test wm-7.1 {window initially withdrawn} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ wm withdraw .t
+ sleep 200
+ set result [winfo ismapped .t]
+ wm deiconify .t
+ list $result [winfo ismapped .t]
+} {0 1}
+test wm-7.2 {window initially withdrawn} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ wm withdraw .t
+ wm deiconify .t
+ sleep 200
+ winfo ismapped .t
+} 1
+
+test wm-8.1 {window initially iconic} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ wm title .t 1
+ wm iconify .t
+ update idletasks
+ list [winfo ismapped .t] [wm state .t]
+} {0 iconic}
+
+# I don't know why the wait below is needed, but without it the test
+# fails under twm.
+sleep 200
+
+test wm-8.2 {window initially iconic} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ wm title .t 2
+ wm iconify .t
+ update idletasks
+ wm withdraw .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+
+catch {destroy .m}
+menu .m
+foreach i {{Test label} Another {Yet another} {Last label}} {
+ .m add command -label $i
+}
+.m post 100 200
+test wm-9.1 {override_redirect and Tk_MoveTopLevelWindow} {
+ list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
+} {1 normal 100 200}
+.m post 150 210
+test wm-9.2 {override_redirect and Tk_MoveTopLevelWindow} {
+ list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
+} {1 normal 150 210}
+.m unpost
+test wm-9.3 {override_redirect and Tk_MoveTopLevelWindow} {
+ list [winfo ismapped .m]
+} 0
+destroy .m
+catch {destroy .t}
+
+test wm-10.1 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ list [catch {wm iconify .icon} msg] $msg
+} {1 {can't iconify .icon: it is an icon for .icon}}
+test wm-10.2 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ list [catch {wm deiconify .icon} msg] $msg
+} {1 {can't deiconify .icon: it is an icon for .icon}}
+test wm-10.3 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ list [catch {wm withdraw .icon} msg] $msg
+} {1 {can't withdraw .icon: it is an icon for .t}}
+test wm-10.4 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test wm-10.5 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow .t b c} msg] $msg
+} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
+test wm-10.6 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geom .t +0+0
+ set result [wm iconwindow .t]
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ lappend result [wm iconwindow .t] [wm state .icon]
+ wm iconwindow .t {}
+ lappend result [wm iconwindow .t] [wm state .icon]
+ update
+ lappend result [winfo ismapped .t] [winfo ismapped .icon]
+ wm iconify .t
+ update
+ lappend result [winfo ismapped .t] [winfo ismapped .icon]
+} {.icon icon {} withdrawn 1 0 0 0}
+test wm-10.7 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow .t .gorp} msg] $msg
+} {1 {bad window path name ".gorp"}}
+test wm-10.8 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ frame .t.icon -width 50 -height 50 -bg red
+ list [catch {wm iconwindow .t .t.icon} msg] $msg
+} {1 {can't use .t.icon as icon window: not at top level}}
+test wm-10.9 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geom .t +0+0
+ toplevel .icon -width 50 -height 50 -bg red
+ toplevel .icon2 -width 50 -height 50 -bg green
+ wm iconwindow .t .icon
+ set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]"
+ wm iconwindow .t .icon2
+ lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2]
+} {.icon icon normal .icon2 withdrawn icon}
+catch {destroy .icon2}
+test wm-10.10 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg red
+ wm geom .icon +0+0
+ update
+ set result [winfo ismapped .icon]
+ toplevel .t -width 100 -height 30
+ wm geom .t +0+0
+ wm iconwindow .t .icon
+ after 500 {set x 1}
+ tkwait variable x
+ lappend result [winfo ismapped .t] [winfo ismapped .icon]
+} {1 1 0}
+test wm-10.11 {icon windows} {nonPortable} {
+ # This test is non-portable because some window managers will
+ # destroy an icon window when it's associated window is destroyed.
+
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ toplevel .icon -width 50 -height 50 -bg red
+ wm geom .t +0+0
+ wm iconwindow .t .icon
+ update
+ set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]"
+ destroy .t
+ wm geom .icon +0+0
+ update
+ lappend result [winfo ismapped .icon] [wm state .icon]
+ wm deiconify .icon
+ update
+ lappend result [winfo ismapped .icon] [wm state .icon]
+} {icon 1 0 0 withdrawn 1 normal}
+
+test wm-11.1 {colormapwindows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -colormap new
+ wm geom .t +0+0
+ frame .t.a -width 100 -height 30
+ frame .t.b -width 100 -height 30 -colormap new
+ pack .t.a .t.b -side top
+ update
+ set x [wm colormapwindows .t]
+ frame .t.c -width 100 -height 30 -colormap new
+ pack .t.c -side top
+ update
+ list $x [wm colormapwindows .t]
+} {{.t.b .t} {.t.b .t.c .t}}
+test wm-11.2 {colormapwindows} {
+ list [catch {wm colormapwindows . 1 2} msg] $msg
+} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}}
+test wm-11.3 {colormapwindows} {
+ list [catch {wm col . "a \{"} msg] $msg
+} {1 {unmatched open brace in list}}
+test wm-11.4 {colormapwindows} {
+ list [catch {wm colormapwindows . foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test wm-11.5 {colormapwindows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -colormap new
+ wm geom .t +0+0
+ frame .t.a -width 100 -height 30
+ frame .t.b -width 100 -height 30
+ frame .t.c -width 100 -height 30
+ pack .t.a .t.b .t.c -side top
+ wm colormapwindows .t {.t.c .t .t.a}
+ wm colormapwindows .t
+} {.t.c .t .t.a}
+test wm-11.6 {colormapwindows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200
+ wm geom .t +0+0
+ frame .t.a -width 100 -height 30
+ frame .t.b -width 100 -height 30
+ frame .t.c -width 100 -height 30
+ pack .t.a .t.b .t.c -side top
+ wm colormapwindows .t {.t.b .t.a}
+ wm colormapwindows .t
+} {.t.b .t.a}
+test wm-11.7 {colormapwindows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -colormap new
+ wm geom .t +0+0
+ set x [wm colormapwindows .t]
+ wm colormapwindows .t {}
+ list $x [wm colormapwindows .t]
+} {{} {}}
+
+catch {destroy .t}
+catch {destroy .icon}
+
+toplevel .t -width 100 -height 50
+wm geom .t +0+0
+update
+test wm-12.1 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test wm-12.2 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . a} msg] $msg
+} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
+test wm-12.3 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . a b c} msg] $msg
+} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
+test wm-12.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
+ wm maxsize .t
+} {1137 870}
+test wm-12.5 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . x 100} msg] $msg
+} {1 {expected integer but got "x"}}
+test wm-12.6 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . 100 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test wm-12.7 {Tk_WmCmd procedure, "maxsize" option} {
+ wm maxsize .t 200 150
+ wm maxsize .t
+} {200 150}
+test wm-12.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
+ # Not portable, because some window managers let applications override
+ # minsize and maxsize.
+
+ wm maxsize .t 200 150
+ wm geom .t 300x200
+ update
+ list [winfo width .t] [winfo height .t]
+} {200 150}
+destroy .t
+
+toplevel .t -width 300 -height 200
+wm geom .t +0+0
+update
+test wm-13.1 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test wm-13.2 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . a} msg] $msg
+} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
+test wm-13.3 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . a b c} msg] $msg
+} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
+test wm-13.4 {Tk_WmCmd procedure, "minsize" option} {
+ wm minsize .t
+} {1 1}
+test wm-13.5 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . x 100} msg] $msg
+} {1 {expected integer but got "x"}}
+test wm-13.6 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . 100 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test wm-13.7 {Tk_WmCmd procedure, "minsize" option} {
+ wm minsize .t 200 150
+ wm minsize .t
+} {200 150}
+test wm-13.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} {
+ # Not portable, because some window managers let applications override
+ # minsize and maxsize.
+
+ wm minsize .t 150 100
+ wm geom .t 50x50
+ update
+ list [winfo width .t] [winfo height .t]
+} {150 100}
+test wm-13.9 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . a} msg] $msg
+} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
+test wm-13.10 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . a b c} msg] $msg
+} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
+test wm-13.11 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable .foo a b c} msg] $msg
+} {1 {bad window path name ".foo"}}
+test wm-13.12 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . x 1} msg] $msg
+} {1 {expected boolean value but got "x"}}
+test wm-13.13 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . 0 gorp} msg] $msg
+} {1 {expected boolean value but got "gorp"}}
+test wm-13.14 {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]
+} {{1 1} {1 0} {0 0} {0 1}}
+destroy .t2
+
+test wm-14.1 {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 wm-15.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 wm-15.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 wm-16.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 wm-17.1 {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 wm-18.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 wm-18.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 wm-18.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 wm-18.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 wm-19.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 wm-19.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
+} {}
+
+catch {destroy .t}
+concat {}
diff --git a/tk/tests/xmfbox.test b/tk/tests/xmfbox.test
new file mode 100644
index 00000000000..fd20939c959
--- /dev/null
+++ b/tk/tests/xmfbox.test
@@ -0,0 +1,156 @@
+# xmfbox.test --
+#
+# This file is a Tcl script to test the file dialog that's used
+# when the tk_strictMotif flag is set. Because the file dialog
+# runs in a modal loop, the only way to test it sufficiently is
+# to call the internal Tcl procedures in xmfbox.tcl directly.
+#
+# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id$
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+set testPWD [pwd]
+eval destroy [winfo children .]
+catch {unset foo}
+
+catch {unset data foo}
+
+proc cleanup {} {
+ global testPWD
+
+ set err0 [catch {
+ cd $testPWD
+ } msg0]
+
+ set err1 [catch {
+ if [file exists ./~nosuchuser1] {
+ file delete ./~nosuchuser1
+ }
+ } msg1]
+
+ set err2 [catch {
+ if [file exists ./~nosuchuser2] {
+ file delete ./~nosuchuser2
+ }
+ } msg2]
+
+ set err3 [catch {
+ if [file exists ./~nosuchuser3] {
+ file delete ./~nosuchuser3
+ }
+ } msg3]
+
+ set err4 [catch {
+ if [file exists ./~nosuchuser4] {
+ file delete ./~nosuchuser4
+ }
+ } msg4]
+
+ if {$err0 || $err1 || $err2 || $err3 || $err4} {
+ error [list $msg0 $msg1 $msg2 $msg3 $msg4]
+ }
+ catch {unset foo}
+ catch {destroy .foo}
+}
+
+test xmfbox-1.1 {tkMotifFDialog_Create, -parent switch} {unixOnly} {
+ catch {unset foo}
+ set x [tkMotifFDialog_Create foo open {-parent .}]
+ catch {destroy $x}
+ set x
+} .foo
+
+test xmfbox-1.2 {tkMotifFDialog_Create, -parent switch} {unixOnly} {
+ catch {unset foo}
+ toplevel .bar
+ wm geometry .bar +0+0
+ set x [tkMotifFDialog_Create foo open {-parent .bar}]
+ catch {destroy $x}
+ catch {destroy .bar}
+ set x
+} .bar.foo
+
+test xmfbox-2.1 {tkMotifFDialog_InterpFilter, ~ in dir names} {unixOnly} {
+ cleanup
+ file mkdir ./~nosuchuser1
+ set x [tkMotifFDialog_Create foo open {}]
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ set kk [tkMotifFDialog_InterpFilter $x]
+} [list $testPWD/~nosuchuser1 *]
+
+test xmfbox-2.2 {tkMotifFDialog_InterpFilter, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tkMotifFDialog_Create foo open {}]
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ set kk [tkMotifFDialog_InterpFilter $x]
+} [list $testPWD ./~nosuchuser1]
+
+test xmfbox-2.3 {tkMotifFDialog_Update, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tkMotifFDialog_Create foo open {}]
+ $::tk::dialog::file::foo(fEnt) delete 0 end
+ $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
+ tkMotifFDialog_InterpFilter $x
+ tkMotifFDialog_Update $x
+ $::tk::dialog::file::foo(fList) get end
+} ~nosuchuser1
+
+test xmfbox-2.4 {tkMotifFDialog_LoadFile, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tkMotifFDialog_Create foo open {}]
+ set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
+ expr {$i >= 0}
+} 1
+
+test xmfbox-2.5 {tkMotifFDialog_BrowseFList, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tkMotifFDialog_Create foo open {}]
+ set i [lsearch [$::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
+ tkMotifFDialog_BrowseFList $x
+ $::tk::dialog::file::foo(sEnt) get
+} $testPWD/~nosuchuser1
+
+test xmfbox-2.5 {tkMotifFDialog_ActivateFList, ~ in file names} {unixOnly} {
+ cleanup
+ close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
+ set x [tkMotifFDialog_Create foo open {}]
+ set i [lsearch [$::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
+ tkMotifFDialog_BrowseFList $x
+ tkMotifFDialog_ActivateFList $x
+ list $::tk::dialog::file::foo(selectPath) \
+ $::tk::dialog::file::foo(selectFile) $tkPriv(selectFilePath)
+} [list $testPWD ~nosuchuser1 $testPWD/~nosuchuser1]
+
+# cleanup
+cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tk/unix/ChangeLog b/tk/unix/ChangeLog
index edb93447c0a..ddf2006c3ab 100644
--- a/tk/unix/ChangeLog
+++ b/tk/unix/ChangeLog
@@ -1,33 +1,3 @@
-Mon Aug 30 12:41:17 1999 Jeffrey A Law (law@cygnus.com)
-
- * configure.in: Do not force static linking for hpux11 in wide
- mode since no static X libraries exist.
- * configure: Rebuilt.
-
-Wed Jan 6 13:45:20 1999 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
-
- * configure.in (TK_SHARED_LIB_FILE): init to dummy name.
- (TK_UNSHARED_LIB_FILE): ditto.
-
- * configure: regenerated.
-
-Thu Jul 9 14:35:35 1998 Felix Lee <flee@cygnus.com>
-
- * configure.in: typo.
- * configure: rebuild.
-
-Tue Jul 7 16:59:07 1998 Felix Lee <flee@cygnus.com>
-
- * configure.in: Undo previous change, which didn't work right.
- Add specialcase to make static link of X work on solaris.
- * configure: Rebuild.
-
-Wed Jun 17 11:40:56 1998 Felix Lee <flee@cygnus.com>
-
- * configure.in: When looking for the X libraries, set LDFLAGS to
- find them statically if that is how we are going to link.
- * configure: Rebuild.
-
Mon Apr 13 17:55:38 1998 Ian Lance Taylor <ian@cygnus.com>
* configure.in: Remove AC_REPLACE_FUNCS(memmove).
diff --git a/tk/unix/Makefile.in b/tk/unix/Makefile.in
index d18075684a9..5c80ea51a65 100644
--- a/tk/unix/Makefile.in
+++ b/tk/unix/Makefile.in
@@ -5,12 +5,12 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# SCCS: @(#) Makefile.in 1.146 97/11/05 11:10:45
+# RCS: @(#) $Id$
# Current Tk version; used in various names.
-TCLVERSION = @TCL_VERSION@
-VERSION = @TK_VERSION@
+TCLVERSION = @TCL_VERSION@
+VERSION = @TK_VERSION@
#----------------------------------------------------------------
# Things you can change to personalize the Makefile for your own
@@ -25,15 +25,19 @@ VERSION = @TK_VERSION@
# at configure-time with the --exec-prefix and --prefix options
# to the "configure" script.
-prefix = @prefix@
-exec_prefix = @exec_prefix@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+includedir = @includedir@
+mandir = @mandir@
# The following definition can be set to non-null for special systems
# like AFS with replication. It allows the pathnames used for installation
# to be different than those used for actually reference files at
# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
# when installing files.
-INSTALL_ROOT =
+INSTALL_ROOT =
# Directory from which applications will reference the library of Tcl
# scripts (note: you can set the TK_LIBRARY environment variable at
@@ -47,7 +51,7 @@ TK_LIB_TRAILER = /lib/tk$(VERSION)
# END CYGNUS LOCAL
# Path name to use when installing library scripts:
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)/$(TK_LIBRARY)
# Directory in which to install the .a or .so binary for the Tk library:
LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
@@ -68,68 +72,89 @@ INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
MAN_INSTALL_DIR = $(INSTALL_ROOT)@mandir@
# Directory in which to install manual entry for wish:
-MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
# Directory in which to install manual entries for Tk's C library
# procedures:
-MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
# Directory in which to install manual entries for the built-in
# Tcl commands implemented by Tk:
-MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
# The directory containing the Tcl sources and headers appropriate
# for this version of Tk ("srcdir" will be replaced or has already
# been replaced by the configure script):
-TCL_GENERIC_DIR = @TCL_SRC_DIR@/generic
+TCL_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@
+TCL_BIN_DIR = @TCL_BIN_DIR@
+
+# Libraries built with optimization switches have this additional extension
+TK_DBGX = @TK_DBGX@
+
+# warning flags
+CFLAGS_WARNING = @CFLAGS_WARNING@
+
+# The default switches for optimization or debugging
+CFLAGS_DEBUG = @CFLAGS_DEBUG@
+CFLAGS_OPTIMIZE = @CFLAGS_OPTIMIZE@
+
+# To change the compiler switches, for example to change from optimization to
+# debugging symbols, change the following line:
+#CFLAGS = $(CFLAGS_DEBUG)
+#CFLAGS = $(CFLAGS_OPTIMIZE)
+#CFLAGS = $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
+CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@
+
+# Flags to pass to the linker
+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@
+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@
+X11_LIB_SWITCHES = @XLIBSW@
-# Libraries to use when linking. This definition is determined by the
-# configure script.
-LIBS = @TCL_BUILD_LIB_SPEC@ @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc
-
-# To change the compiler switches, for example to change from -O
-# to -g, change the following line:
-CFLAGS = @CFLAGS@
# To turn off the security checks that disallow incoming sends when
# the X server appears to be insecure, reverse the comments on the
# following lines:
-SECURITY_FLAGS =
-#SECURITY_FLAGS = -DTK_NO_SECURITY
+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
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
# To enable memory debugging reverse the comment characters on the following
# lines. Warning: if you enable memory debugging, you must do it
# *everywhere*, including all the code that calls Tcl, and you must use
# ckalloc and ckfree everywhere instead of malloc and free.
-MEM_DEBUG_FLAGS =
-#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
# If your X server is X11R4 or earlier, then you may wish to reverse
# the comment characters on the following two lines. This will enable
# extra code to speed up XStringToKeysym. In X11R5 and later releases
# XStringToKeysym is plenty fast, so you needn't define REDO_KEYSYM_LOOKUP.
-KEYSYM_FLAGS =
-#KEYSYM_FLAGS = -DREDO_KEYSYM_LOOKUP
+KEYSYM_FLAGS =
+#KEYSYM_FLAGS = -DREDO_KEYSYM_LOOKUP
+
+# Tk does not used deprecated Tcl constructs so it should
+# compile fine with -DTCL_NO_DEPRECATED. To remove its own
+# set of deprecated code uncomment the second line.
+NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED
+#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED -DTK_NO_DEPRECATED
# Some versions of make, like SGI's, use the following variable to
# determine which shell to use for executing commands:
@@ -140,9 +165,16 @@ SHELL = @SHELL@
# "install" around; better to use the install-sh script that comes
# with the distribution, which is slower but guaranteed to work.
-INSTALL = @srcdir@/install-sh -c
-INSTALL_PROGRAM = ${INSTALL}
-INSTALL_DATA = ${INSTALL} -m 644
+INSTALL = @srcdir@/install-sh -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+
+# The following specifies which Tcl executable to use for make targets
+# below. This can generally be 'tclsh', meaning all targets will work
+# once we have created the initial executable, but in some cases you
+# may want to use a target without having made tclsh on these sources
+# (like for make genstubs)
+TCL_EXE = tclsh
# The symbols below provide support for dynamic loading and shared
@@ -150,22 +182,42 @@ INSTALL_DATA = ${INSTALL} -m 644
# configure script. You shouldn't normally need to modify any of
# these definitions by hand.
-TK_SHLIB_CFLAGS = @TK_SHLIB_CFLAGS@
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+
+# To enable support for stubs in Tcl.
+STUB_LIB_FILE = @TK_STUB_LIB_FILE@
+
+TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@
+#TK_STUB_LIB_FILE = libtkstub.a
+
+TK_STUB_LIB_FLAG = @TK_STUB_LIB_FLAG@
+#TK_STUB_LIB_FLAG = -ltkstub
+
+TK_LIB_FILE = @TK_LIB_FILE@
+#TK_LIB_FILE = libtk.a
-TK_LIB_FILE = @TK_LIB_FILE@
-#TK_LIB_FILE = libtk.a
+TK_LIB_FLAG = @TK_LIB_FLAG@
+#TK_LIB_FLAG = -ltk
-TK_LIB_FLAG = @TK_LIB_FLAG@
-#TK_LIB_FLAG = -ltk
+TCL_BUILD_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
-TCL_LIB_FLAG = @TCL_LIB_FLAG@
-#TCL_LIB_FLAG = -ltcl
+TK_EXP_FILE = @TK_EXP_FILE@
+TK_BUILD_EXP_FILE = @TK_BUILD_EXP_FILE@
+
+TCL_STUB_FLAGS = @TCL_STUB_FLAGS@
+
+# Libraries to use when linking. This definition is determined by the
+# configure script.
+LIBS = @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc
+WISH_LIBS = $(TCL_BUILD_LIB_SPEC) @LIBS@ $(X11_LIB_SWITCHES) @DL_LIBS@ @MATH_LIBS@ -lc
# The symbol below provides support for dynamic loading and shared
# libraries. See configure.in for a description of what it means.
# The values of the symbolis normally set by the configure script.
+STLIB_LD = @STLIB_LD@
SHLIB_LD = @SHLIB_LD@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
# CYGNUS LOCAL
# Defines for building libtk
@@ -174,12 +226,17 @@ TCL_SHARED_LIB_SUFFIX = @TCL_SHARED_LIB_SUFFIX@
TCL_UNSHARED_LIB_SUFFIX = @TCL_UNSHARED_LIB_SUFFIX@
TK_SHARED_LIB_FILE = @TK_SHARED_LIB_FILE@
TK_UNSHARED_LIB_FILE = @TK_UNSHARED_LIB_FILE@
+# END CYGNUS LOCAL
+
+SHLIB_LD = @SHLIB_LD@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@
+
# Additional search flags needed to find the various shared libraries
# at run-time. The first symbol is for use when creating a binary
# with cc, and the second is for use when running ld directly.
-TK_CC_SEARCH_FLAGS = @TK_CC_SEARCH_FLAGS@
-TK_LD_SEARCH_FLAGS = @TK_LD_SEARCH_FLAGS@
+TK_CC_SEARCH_FLAGS = @TK_CC_SEARCH_FLAGS@
+TK_LD_SEARCH_FLAGS = @TK_LD_SEARCH_FLAGS@
#----------------------------------------------------------------
# The information below is modified by the configure script when
@@ -187,14 +244,15 @@ TK_LD_SEARCH_FLAGS = @TK_LD_SEARCH_FLAGS@
# modify any of this stuff by hand.
#----------------------------------------------------------------
-AC_FLAGS = @DEFS@
-RANLIB = @RANLIB@
-SRC_DIR = @srcdir@/..
-TOP_DIR = @srcdir@/..
-GENERIC_DIR = $(TOP_DIR)/generic
-UNIX_DIR = @srcdir@
-BMAP_DIR = $(TOP_DIR)/bitmaps
-TOOL_DIR = @TCL_SRC_DIR@/tools
+AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
+AR = @AR@
+RANLIB = @RANLIB@
+SRC_DIR = @srcdir@/..
+TOP_DIR = @srcdir@/..
+GENERIC_DIR = $(TOP_DIR)/generic
+UNIX_DIR = @srcdir@
+BMAP_DIR = $(TOP_DIR)/bitmaps
+TOOL_DIR = @TCL_SRC_DIR@/tools
#----------------------------------------------------------------
# The information below should be usable as is. The configure
@@ -202,12 +260,15 @@ TOOL_DIR = @TCL_SRC_DIR@/tools
# either.
#----------------------------------------------------------------
+CC = @CC@
-CC = @CC@
-CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TK_SHLIB_CFLAGS} \
+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}
+-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} \
@@ -217,7 +278,9 @@ ${KEYSYM_FLAGS}
WISH_OBJS = tkAppInit.o
-TKTEST_OBJS = tkTestInit.o tkTest.o tkSquare.o
+TCLTEST_OBJS = ${TCL_BIN_DIR}/tclTest.o ${TCL_BIN_DIR}/tclThreadTest.o \
+ ${TCL_BIN_DIR}/tclUnixTest.o
+TKTEST_OBJS = $(TCLTEST_OBJS) tkTestInit.o tkTest.o tkSquare.o
WIDGOBJS = tkButton.o tkEntry.o tkFrame.o tkListbox.o \
tkMenu.o tkMenubutton.o tkMenuDraw.o tkMessage.o tkScale.o \
@@ -232,19 +295,25 @@ IMAGEOBJS = tkImage.o tkImgBmap.o tkImgGIF.o tkImgPPM.o tkImgPhoto.o
TEXTOBJS = tkText.o tkTextBTree.o tkTextDisp.o tkTextImage.o tkTextIndex.o \
tkTextMark.o tkTextTag.o tkTextWind.o
-UNIXOBJS = tkUnix.o tkUnix3d.o tkUnixButton.o tkUnixColor.o tkUnixCursor.o \
- tkUnixDialog.o tkUnixDraw.o \
- tkUnixEmbed.o tkUnixEvent.o tkUnixFocus.o tkUnixFont.o tkUnixInit.o \
- tkUnixMenu.o tkUnixMenubu.o tkUnixScale.o tkUnixScrlbr.o \
- tkUnixSelect.o tkUnixSend.o tkUnixWm.o tkUnixXId.o
+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 tkCursor.o tkError.o tkEvent.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 tkOption.o tkPack.o tkPlace.o \
- tkSelect.o tkUtil.o tkVisual.o tkWindow.o \
+ tkMain.o tkObj.o tkOldConfig.o tkOption.o tkPack.o tkPlace.o \
+ tkSelect.o tkUtil.o tkVisual.o tkWindow.o \
$(UNIXOBJS) $(WIDGOBJS) $(CANVOBJS) $(IMAGEOBJS) $(TEXTOBJS)
+TK_DECLS = \
+ $(GENERIC_DIR)/tk.decls \
+ $(GENERIC_DIR)/tkInt.decls
+
SRCS = \
$(GENERIC_DIR)/tk3d.c $(GENERIC_DIR)/tkArgv.c \
$(GENERIC_DIR)/tkAtom.c $(GENERIC_DIR)/tkBind.c \
@@ -255,12 +324,12 @@ SRCS = \
$(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)/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)/tkUtil.c \
$(GENERIC_DIR)/tkVisual.c $(GENERIC_DIR)/tkWindow.c \
- $(GENERIC_DIR)/tkButton.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 \
@@ -280,15 +349,19 @@ SRCS = \
$(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)/tkUnixDialog.c $(UNIX_DIR)/tkUnixDraw.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 \
@@ -300,48 +373,68 @@ HDRS = bltList.h \
default.h ks_names.h tkPatch.h tk.h tkButton.h tkCanvas.h tkInt.h \
tkPort.h tkScrollbar.h tkText.h
+INSTALL_HDRS = $(GENERIC_DIR)/tk.h \
+ $(GENERIC_DIR)/tkInt.h \
+ $(GENERIC_DIR)/tkDecls.h \
+ $(GENERIC_DIR)/tkIntXlibDecls.h
+
DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
-all: wish
+all: binaries libraries doc
-# CYGNUS LOCAL
+binaries: ${TK_LIB_FILE} ${STUB_LIB_FILE} wish
-# The shared- and unshared-library cases are separate, so that RANLIB
-# can unconditionally work.
+libraries:
-${TK_SHARED_LIB_FILE}: ${OBJS}
- rm -f @TK_LIB_FILE@
- @MAKE_LIB@
+$(SRC_DIR)/doc/man.macros:
+ chmod +x $(UNIX_DIR)/install-sh
+ $(INSTALL_DATA) @TCL_SRC_DIR@/doc/man.macros $(SRC_DIR)/doc/man.macros
-${TK_UNSHARED_LIB_FILE}: ${OBJS}
- rm -f @TK_LIB_FILE@
+doc: $(SRC_DIR)/doc/man.macros
+
+# The following target is configured by autoconf to generate either
+# a shared library or non-shared library for Tk.
+${TK_LIB_FILE}: ${OBJS}
+ rm -f ${TK_LIB_FILE}
@MAKE_LIB@
$(RANLIB) ${TK_LIB_FILE}
-# END CYGNUS LOCAL
+${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
+ rm -f ${STUB_LIB_FILE}
+ @MAKE_STUB_LIB@
+ $(RANLIB) ${STUB_LIB_FILE}
# Make target which outputs the list of the .o contained in the Tk lib
# usefull to build a single big shared library containing Tcl/Tk and other
# extensions. used for the Tcl Plugin. -- dl
tkLibObjs:
@echo ${OBJS}
+
# This targets actually build the objects needed for the lib in the above
# case
objs: ${OBJS}
-wish: $(WISH_OBJS) $(TK_LIB_FILE)
- $(CC) @LD_FLAGS@ $(WISH_OBJS) @TK_BUILD_LIB_SPEC@ $(LIBS) \
- $(TK_CC_SEARCH_FLAGS) -o wish
+wish: $(WISH_OBJS) $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) @TCL_LIB_FULL_PATH@
+ $(CC) $(LDFLAGS) $(WISH_OBJS) \
+ @TK_BUILD_LIB_SPEC@ \
+ $(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o wish
+
+# This rule is executed if the user tried to run tktest without first
+# building tcltest in the Tcl bin directory. Just do it for them.
+${TCL_BIN_DIR}/tcltest:
+ cd ${TCL_BIN_DIR} ; \
+ make tcltest
-tktest: $(TKTEST_OBJS) $(TK_LIB_FILE)
- ${CC} @LD_FLAGS@ $(TKTEST_OBJS) @TK_BUILD_LIB_SPEC@ $(LIBS) \
- $(TK_CC_SEARCH_FLAGS) -o tktest
+tktest: ${TCL_BIN_DIR}/tcltest $(TKTEST_OBJS) $(TK_LIB_FILE) @TCL_LIB_FULL_PATH@
+ ${CC} $(LDFLAGS) $(TKTEST_OBJS) \
+ @TK_BUILD_LIB_SPEC@ \
+ $(WISH_LIBS) $(TK_CC_SEARCH_FLAGS) -o tktest
-xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
- ${CC} @LD_FLAGS@ test.o tkTest.o tkSquare.o \
- @TK_BUILD_LIB_SPEC@ $(LIBS) \
- @TK_LD_SEARCH_FLAGS@ -lXt -o xttest
+xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE) @TCL_LIB_FULL_PATH@
+ ${CC} $(LDFLAGS) test.o tkTest.o tkSquare.o \
+ @TK_BUILD_LIB_SPEC@ \
+ $(WISH_LIBS) $(TK_LD_SEARCH_FLAGS) -lXt -o xttest
# Note, in the target below TCL_LIBRARY needs to be set or else
# "make test" won't work in the case where the compilation directory
@@ -350,48 +443,63 @@ xttest: test.o tkTest.o tkSquare.o $(TK_LIB_FILE)
test: tktest
LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \
export LD_LIBRARY_PATH; \
+ LIBPATH=`pwd`:${TCL_BIN_DIR}:${LIBPATH}; export LIBPATH; \
SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \
export SHLIB_PATH; \
TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TK_LIBRARY=$(TOP_DIR)/library; export TK_LIBRARY; \
- ( echo cd $(TOP_DIR)/tests\; source all\; exit ) \
- | ./tktest -geometry +0+0
-
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
+ ./tktest $(TOP_DIR)/tests/all.tcl -geometry +0+0 $(TCLTESTARGS)
# Useful target to launch a built tktest with the proper path,...
-runtest:
+runtest: tktest
LD_LIBRARY_PATH=`pwd`:${TCL_BIN_DIR}:${LD_LIBRARY_PATH}; \
export LD_LIBRARY_PATH; \
- SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \
- export SHLIB_PATH; \
+ LIBPATH=`pwd`:${TCL_BIN_DIR}:${LIBPATH}; export LIBPATH; \
+ SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; export SHLIB_PATH; \
TCL_LIBRARY=@TCL_SRC_DIR@/library; export TCL_LIBRARY; \
- TK_LIBRARY=$(TOP_DIR)/library; export TK_LIBRARY; \
+ TK_LIBRARY=@TK_SRC_DIR@/library; export TK_LIBRARY; \
./tktest
-install: install-binaries install-libraries install-demos install-man
+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: $(TK_LIB_FILE) wish
+install-binaries: $(TK_LIB_FILE) $(TK_STUB_LIB_FILE) $(TK_BUILD_EXP_FILE) wish
@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @echo "Installing $(TK_LIB_FILE)"
+ @if test ! -x $(UNIX_DIR)/install-sh; then \
+ chmod +x $(UNIX_DIR)/install-sh; \
+ fi
+ @if test ! -x $(UNIX_DIR)/mkLinks; then \
+ chmod +x $(UNIX_DIR)/mkLinks; \
+ fi
+ @echo "Installing $(TK_LIB_FILE) to $(LIB_INSTALL_DIR)/"
@$(INSTALL_DATA) $(TK_LIB_FILE) $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
@(cd $(LIB_INSTALL_DIR); $(RANLIB) $(TK_LIB_FILE))
@chmod 555 $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
- @echo "Installing wish"
- @$(INSTALL_PROGRAM) wish $(BIN_INSTALL_DIR)/wish
- @echo "Installing tkConfig.sh"
+ @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 "$(TK_STUB_LIB_FILE)" != "" ; then \
+ echo "Installing $(TK_STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
+ $(INSTALL_DATA) $(STUB_LIB_FILE) \
+ $(LIB_INSTALL_DIR)/$(TK_STUB_LIB_FILE); \
+ fi
install-libraries:
@for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
@@ -399,22 +507,29 @@ install-libraries:
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @echo "Installing tk.h"
- @$(INSTALL_DATA) $(GENERIC_DIR)/tk.h $(INCLUDE_INSTALL_DIR)/tk.h
- for i in $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex $(SRC_DIR)/library/prolog.ps $(UNIX_DIR)/tkAppInit.c; \
+ @if test ! -x $(UNIX_DIR)/install-sh; then \
+ chmod +x $(UNIX_DIR)/install-sh; \
+ fi
+ @echo "Installing header files";
+ @for i in $(INSTALL_HDRS) ; \
+ do \
+ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
+ done;
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
+ @for i in $(SRC_DIR)/library/*.tcl $(GENERIC_DIR)/prolog.ps \
+ $(SRC_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \
do \
- echo "Installing $$i"; \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
- for i in $(SRC_DIR)/library/images/*; \
+ @echo "Installing library images directory";
+ @for i in $(SRC_DIR)/library/images/*; \
do \
if [ -f $$i ] ; then \
- echo "Installing $$i"; \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/images; \
fi; \
done;
@@ -444,15 +559,15 @@ install-demos:
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
+ @echo "Installing demos to $(SCRIPT_INSTALL_DIR)/demos/";
@for i in $(SRC_DIR)/library/demos/*; \
do \
if [ -f $$i ] ; then \
- echo "Installing $$i"; \
sed -e '3 s|exec wish|exec wish$(VERSION)|' \
$$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \
fi; \
@@ -461,51 +576,54 @@ install-demos:
do \
chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
done;
+ @echo "Installing demo images";
@for i in $(SRC_DIR)/library/demos/images/*; \
do \
if [ -f $$i ] ; then \
- echo "Installing $$i"; \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
fi; \
done;
-install-man:
- @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) ; \
+install-doc:
+ @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) $(MANN_INSTALL_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ mkdir -p $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
+ @echo "Installing top-level (.1) docs";
@cd $(SRC_DIR)/doc; for i in *.1; \
do \
- echo "Installing doc/$$i"; \
rm -f $(MAN1_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN1_INSTALL_DIR)/$$i; \
chmod 644 $(MAN1_INSTALL_DIR)/$$i; \
done;
- $(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @echo "Cross-linking top-level (.1) docs";
+ @$(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @echo "Installing C API (.3) docs";
@cd $(SRC_DIR)/doc; for i in *.3; \
do \
- echo "Installing doc/$$i"; \
rm -f $(MAN3_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN3_INSTALL_DIR)/$$i; \
chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
done;
+ @echo "Cross-linking top-level (.3) docs";
+ @$(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+ @echo "Installing command (.n) docs";
@cd $(SRC_DIR)/doc; for i in *.n; \
do \
- echo "Installing doc/$$i"; \
- rm -f $(MAN3_INSTALL_DIR)/$$i; \
- name=`echo $$i | sed -e 's/n$$/3/'`; \
+ rm -f $(MANN_INSTALL_DIR)/$$i; \
sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
$$i > $(MAN3_INSTALL_DIR)/$$name; \
chmod 644 $(MAN3_INSTALL_DIR)/$$name; \
done;
- $(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+ @echo "Cross-linking command (.n) docs";
+ @$(UNIX_DIR)/mkLinks $(MANN_INSTALL_DIR)
Makefile: $(UNIX_DIR)/Makefile.in config.status
$(SHELL) config.status
@@ -519,7 +637,7 @@ clean:
distclean: clean
rm -f Makefile config.status config.cache config.log tkConfig.sh \
- SUNWtk.* prototype
+ $(PACKAGE).* prototype
depend:
makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
@@ -533,19 +651,19 @@ tkTestInit.o: $(UNIX_DIR)/tkAppInit.c
rm -f tkAppInit.sav; \
mv tkAppInit.o tkAppInit.sav; \
fi;
- $(CC) -c $(CC_SWITCHES) -DTK_TEST $(UNIX_DIR)/tkAppInit.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) -DTK_TEST $(UNIX_DIR)/tkAppInit.c
rm -f tkTestInit.o
mv tkAppInit.o tkTestInit.o
@if test -f tkAppInit.sav ; then \
mv tkAppInit.sav tkAppInit.o; \
fi;
+tkAppInit.o: $(UNIX_DIR)/tkAppInit.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) $(UNIX_DIR)/tkAppInit.c
+
tk3d.o: $(GENERIC_DIR)/tk3d.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tk3d.c
-tkAppInit.o: $(UNIX_DIR)/tkAppInit.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkAppInit.c
-
tkArgv.o: $(GENERIC_DIR)/tkArgv.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkArgv.c
@@ -570,6 +688,9 @@ tkColor.o: $(GENERIC_DIR)/tkColor.c
tkConfig.o: $(GENERIC_DIR)/tkConfig.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConfig.c
+tkConsole.o: $(GENERIC_DIR)/tkConsole.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConsole.c
+
tkCursor.o: $(GENERIC_DIR)/tkCursor.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCursor.c
@@ -603,6 +724,12 @@ tkGrid.o: $(GENERIC_DIR)/tkGrid.c
tkMain.o: $(GENERIC_DIR)/tkMain.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMain.c
+tkObj.o: $(GENERIC_DIR)/tkObj.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkObj.c
+
+tkOldConfig.o: $(GENERIC_DIR)/tkOldConfig.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOldConfig.c
+
tkOption.o: $(GENERIC_DIR)/tkOption.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkOption.c
@@ -655,7 +782,7 @@ tkScrollbar.o: $(GENERIC_DIR)/tkScrollbar.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkScrollbar.c
tkSquare.o: $(GENERIC_DIR)/tkSquare.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkSquare.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkSquare.c
tkCanvas.o: $(GENERIC_DIR)/tkCanvas.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvas.c
@@ -709,7 +836,7 @@ tkImgPhoto.o: $(GENERIC_DIR)/tkImgPhoto.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgPhoto.c
tkTest.o: $(GENERIC_DIR)/tkTest.c
- $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTest.c
+ $(CC) -c $(CC_SWITCHES_NO_STUBS) $(GENERIC_DIR)/tkTest.c
tkText.o: $(GENERIC_DIR)/tkText.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkText.c
@@ -735,6 +862,18 @@ tkTextTag.o: $(GENERIC_DIR)/tkTextTag.c
tkTextWind.o: $(GENERIC_DIR)/tkTextWind.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextWind.c
+tkStubInit.o: $(GENERIC_DIR)/tkStubInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubInit.c
+
+# Stub library binaries, these must be compiled for use in a shared library
+# even though they will be placed in a static archive
+
+tkStubLib.o: $(GENERIC_DIR)/tkStubLib.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubLib.c
+
+tkStubImg.o: $(GENERIC_DIR)/tkStubImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkStubImg.c
+
tkUnix.o: $(UNIX_DIR)/tkUnix.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnix.c
@@ -747,12 +886,12 @@ tkUnixButton.o: $(UNIX_DIR)/tkUnixButton.c
tkUnixColor.o: $(UNIX_DIR)/tkUnixColor.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixColor.c
+tkUnixConfig.o: $(UNIX_DIR)/tkUnixConfig.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixConfig.c
+
tkUnixCursor.o: $(UNIX_DIR)/tkUnixCursor.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixCursor.c
-tkUnixDialog.o: $(UNIX_DIR)/tkUnixDialog.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDialog.c
-
tkUnixDraw.o: $(UNIX_DIR)/tkUnixDraw.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixDraw.c
@@ -772,6 +911,9 @@ tkUnixInit.o: $(UNIX_DIR)/tkUnixInit.c $(GENERIC_DIR)/tkInitScript.h tkConfig.sh
$(CC) -c $(CC_SWITCHES) -DTK_LIBRARY=\"${TK_LIBRARY}\" \
$(UNIX_DIR)/tkUnixInit.c
+tkUnixKey.o: $(UNIX_DIR)/tkUnixKey.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixKey.c
+
tkUnixMenu.o: $(UNIX_DIR)/tkUnixMenu.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixMenu.c
@@ -814,6 +956,46 @@ checkuchar:
checkexports: $(TK_LIB_FILE)
-nm -p $(TK_LIB_FILE) | awk '$$2 ~ /[TDB]/ { print $$3 }' | sort -n | grep -v '^[Tt]k'
+# Target to regenerate header files and stub files from the *.decls tables.
+#
+
+genstubs:
+ $(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
+ $(GENERIC_DIR)/tk.decls $(GENERIC_DIR)/tkInt.decls
+
+#
+# Target to check that all exported functions have an entry in the stubs
+# tables.
+#
+
+checkstubs:
+ -@for i in `nm -p $(TK_LIB_FILE) | awk '$$2 ~ /T/ { print $$3 }' \
+ | sort -n`; do \
+ match=0; \
+ for j in $(TK_DECLS); do \
+ if [ `grep -c $$i $$j` -gt 0 ]; then \
+ match=1; \
+ fi; \
+ done; \
+ if [ $$match -eq 0 ]; then echo $$i; fi \
+ done
+
+
+#
+# Target to create a 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.TK.SPEC
+ echo "%define _rpmdir `pwd`/RPMS" >> THIS.TK.SPEC
+ cat tk.spec >> THIS.TK.SPEC
+ mkdir -p RPMS/i386
+ rpm -bb THIS.TK.SPEC
+ mv RPMS/i386/*.rpm .
+ rm -rf RPMS THIS.TK.SPEC
+
#
# Target to create a proper Tk distribution from information in the
# master source directory. DISTDIR must be defined to indicate where
@@ -830,18 +1012,18 @@ $(UNIX_DIR)/configure:
dist: $(UNIX_DIR)/configure
rm -rf $(DISTDIR)
- mkdir $(DISTDIR)
+ mkdir -p $(DISTDIR)
mkdir $(DISTDIR)/unix
cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix
cp $(TOP_DIR)/license.terms $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
chmod 664 $(DISTDIR)/unix/Makefile.in
cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
+ $(UNIX_DIR)/aclocal.m4 \
$(UNIX_DIR)/tkConfig.sh.in $(TCLDIR)/unix/install-sh \
- $(UNIX_DIR)/porting.notes $(UNIX_DIR)/porting.old \
$(UNIX_DIR)/README $(DISTDIR)/unix
chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
chmod +x $(DISTDIR)/unix/install-sh
- tclsh $(TCLDIR)/unix/mkLinks.tcl $(TOP_DIR)/doc/*.[13n] \
+ $(TCL_EXE) $(TCLDIR)/unix/mkLinks.tcl $(TOP_DIR)/doc/*.[13n] \
> $(DISTDIR)/unix/mkLinks
chmod +x $(DISTDIR)/unix/mkLinks
mkdir $(DISTDIR)/bitmaps
@@ -852,12 +1034,20 @@ dist: $(UNIX_DIR)/configure
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 $(TOP_DIR)/changes $(TOP_DIR)/README $(TOP_DIR)/license.terms \
- $(DISTDIR)
+ 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/tkConfig.sh.in \
+ $(TOP_DIR)/win/aclocal.m4 \
+ $(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.c $(TOP_DIR)/win/*.h $(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
@@ -868,10 +1058,7 @@ dist: $(UNIX_DIR)/configure
$(TOP_DIR)/win/rc/*.ico $(TOP_DIR)/win/rc/*.bmp \
$(DISTDIR)/win/rc
mkdir $(DISTDIR)/mac
- sccs edit -s $(TOP_DIR)/mac/tkMacProjects.sea.hqx
- cp -p tkMacProjects.sea.hqx $(DISTDIR)/mac
- sccs unedit $(TOP_DIR)/mac/tkMacProjects.sea.hqx
- rm -f tkMacProjects.sea.hqx
+ cp -p $(TOP_DIR)/mac/tkMacProjects.sea.hqx $(DISTDIR)/mac
cp -p $(TOP_DIR)/mac/*.c $(TOP_DIR)/mac/*.h $(TOP_DIR)/mac/*.r \
$(DISTDIR)/mac
cp -p $(TOP_DIR)/mac/README $(DISTDIR)/mac
@@ -892,7 +1079,7 @@ dist: $(UNIX_DIR)/configure
cp -p $(TOP_DIR)/license.terms $(DISTDIR)/xlib/X11
mkdir $(DISTDIR)/library
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
- $(TOP_DIR)/library/tclIndex $(TOP_DIR)/library/prolog.ps \
+ $(TOP_DIR)/library/tclIndex \
$(DISTDIR)/library
mkdir $(DISTDIR)/library/images
@(cd $(TOP_DIR); for i in library/images/* ; do \
@@ -923,10 +1110,8 @@ dist: $(UNIX_DIR)/configure
$(TCLDIR)/doc/man.macros $(DISTDIR)/doc
mkdir $(DISTDIR)/tests
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/tests/*.test \
- $(TOP_DIR)/tests/visual $(TOP_DIR)/tests/*.tcl \
- $(TOP_DIR)/tests/README $(TOP_DIR)/tests/all \
- $(TOP_DIR)/tests/defs $(TOP_DIR)/tests/option.file* \
- $(DISTDIR)/tests
+ $(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
@@ -939,7 +1124,7 @@ alldist: dist
$(DISTROOT)/$(ZIPNAME)
cd $(DISTROOT); tar cf $(DISTNAME).tar $(DISTNAME); \
gzip -9 -c $(DISTNAME).tar > $(DISTNAME).tar.gz; \
- compress $(DISTNAME).tar; zip -r8 $(ZIPNAME) $(DISTNAME)
+ compress $(DISTNAME).tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
#
# The target below is similar to "alldist" except it works for patch
@@ -970,11 +1155,11 @@ allpatch: dist
macdist: dist
rm -f $(DISTDIR)/mac/tkMacProjects.sea.hqx
- tclsh $(TOOL_DIR)/man2html.tcl $(DISTDIR)/tmp ../.. tk$(VERSION)
+ $(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
- tclsh $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
+ $(TCL_EXE) $(TOOL_DIR)/cvtEOL.tcl $(DISTDIR)
#
# Targets to build Solaris package of the distribution for the current
@@ -1022,7 +1207,7 @@ package-config:
package-common:
cd $(DISTDIR)/unix/`arch`;\
$(MAKE); \
- $(MAKE) install-libraries install-man \
+ $(MAKE) install-libraries install-doc \
prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \
exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`
mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin
@@ -1052,10 +1237,11 @@ package-generate:
$(DISTDIR)/SUNWtcl/$(TCLVERSION)/lib=lib \
$(DISTDIR)/SUNWtcl/$(TCLVERSION)/man=man \
$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`=`arch` \
- | tclsh $(TCLDIR)/unix/mkProto.tcl $(TCLVERSION) \
+ | $(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)
# DO NOT DELETE THIS LINE -- make depend depends on it.
+
diff --git a/tk/unix/README b/tk/unix/README
index 2ee3d41173e..994c1bc54ed 100644
--- a/tk/unix/README
+++ b/tk/unix/README
@@ -1,7 +1,17 @@
+Tk UNIX README
+--------------
+
This is the directory where you configure, compile, test, and install
UNIX versions of Tk. This directory also contains source files for Tk
that are specific to UNIX.
+The information in this file is maintained at:
+ http://dev.scriptics.com/doc/howto/compile.html
+
+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://dev.scriptics.com/software/tcltk/platforms.html
+
The rest of this file contains instructions on how to do this. The
release should compile and run either "out of the box" or with trivial
changes on any UNIX-like system that approximates POSIX, BSD, or System
@@ -15,9 +25,9 @@ RCS: @(#) $Id$
How To Compile And Install Tk:
------------------------------
-(a) Make sure that the Tcl 8.0 release is present in the directory
- ../../tcl8.0 (or else use the "--with-tcl" switch described below).
- This release of Tk will only work with Tcl 8.0. Also, be sure that
+(a) Make sure that the Tcl 8.3 release is present in the directory
+ ../../tcl8.3 (or else use the "--with-tcl" switch described below).
+ This release of Tk will only work with Tcl 8.3. Also, be sure that
you have configured Tcl before you configure Tk.
(b) Check for patches as described in ../README.
@@ -38,6 +48,8 @@ How To Compile And Install Tk:
itself to use gcc if it is available on your
system. Note: it is not safe to modify the
Makefile to use gcc after configure is run.
+ --enable-threads Tk on Unix currently does not support
+ threaded builds.
--with-tcl=DIR Specifies the directory containing the Tcl
binaries and Tcl's platform-dependent
configuration information. By default
@@ -45,19 +57,23 @@ How To Compile And Install Tk:
location given by (a) above.
--enable-shared If this switch is specified, Tk will compile
itself as a shared library if it can figure
- out how to do that on this platform.
+ 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, Tk will compile
+ itself as a static library.
Note: be sure to use only absolute path names (those starting with "/")
in the --prefix and --exec_prefix options.
-(e) Type "make". This will create a library archive called "libtk.a"
- or "libtk.so" and an interpreter application called "wish" that
- allows you to type Tcl commands interactively or execute script files.
+(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.
(f) If the make fails then you'll have to personalize the Makefile
for your site or possibly modify the distribution in other ways.
- First check the file "porting.notes" to see if there are hints
- for compiling on your system. Then look at the porting Web page
- described later in this file. If you need to modify Makefile,
+ First check the porting Web page above to see if there are hints
+ for compiling on your system. If you need to modify Makefile,
there are comments at the beginning of it that describe the things
you might want to change and how to change them.
@@ -78,23 +94,15 @@ How To Compile And Install Tk:
TCL_LIBRARY environment variable as well (see the Tcl README file
for information on this). Note that installed versions of wish,
libtk.a, libtk.so, and the Tk library have a version number in their
- names, such as "wish8.0" or "libtk8.0.so"; to use the installed
+ names, such as "wish8.3" or "libtk8.3.so"; to use the installed
versions, either specify the version number or create a symbolic
- link (e.g. from "wish" to "wish8.0").
-
-If you have trouble compiling Tk, read through the file "porting.notes".
-It contains information that people have provided about changes they had
-to make to compile Tcl in various environments. Or, check out the
-following Web URL:
- http://www.sunlabs.com/cgi-bin/tcl/info.8.0
-This is an on-line database of porting information. We make no guarantees
-that this information is accurate, complete, or up-to-date, but you may
-find it useful. If you get Tk running on a new configuration and had to
-make non-trivial changes to do it, we'd be happy to receive new information
-to add to "porting.notes". You can also make a new entry into the
-on-line Web database. We're also interested in hearing how to change the
-configuration setup so that Tcl compiles on additional platforms "out of
-the box".
+ link (e.g. from "wish" to "wish8.3").
+
+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 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
----------
@@ -123,3 +131,5 @@ Postscript generation, etc. These tests all have to be run manually and
the results have to be verified visually. To run the tests, cd to the
"tests" directory and run the script "visual". It will present a main
window with a bunch of menus, which you can use to select various tests.
+
+
diff --git a/tk/unix/aclocal.m4 b/tk/unix/aclocal.m4
new file mode 100644
index 00000000000..005783c4aae
--- /dev/null
+++ b/tk/unix/aclocal.m4
@@ -0,0 +1,2 @@
+builtin(include,tcl.m4)
+builtin(include,../cygtcl.m4)
diff --git a/tk/unix/configure b/tk/unix/configure
index 2b0b092e086..aa9968aab13 100755
--- a/tk/unix/configure
+++ b/tk/unix/configure
@@ -12,13 +12,21 @@ ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
ac_help="$ac_help
- --enable-gcc allow use of gcc if available"
+ --enable-threads build with threads"
ac_help="$ac_help
- --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ --with-tcl directory containing tcl configuration (tclConfig.sh)"
+ac_help="$ac_help
+ --enable-64bit enable 64bit support (where applicable)"
+ac_help="$ac_help
+ --enable-64bit-vis enable 64bit Sparc VIS support"
+ac_help="$ac_help
+ --disable-load disallow dynamic loading and "load" command"
+ac_help="$ac_help
+ --enable-symbols build with debugging symbols [--disable-symbols]"
ac_help="$ac_help
--with-x use the X Window System"
ac_help="$ac_help
- --enable-shared build libtk as a shared library"
+ --enable-shared build and link with shared libraries [--enable-shared]"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -36,6 +44,7 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
+sitefile=
srcdir=
target=NONE
verbose=
@@ -150,6 +159,7 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
+ --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -320,6 +330,11 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
+ -site-file | --site-file | --site-fil | --site-fi | --site-f)
+ ac_prev=sitefile ;;
+ -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+ sitefile="$ac_optarg" ;;
+
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -485,12 +500,16 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+if test -z "$sitefile"; then
+ if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
fi
+else
+ CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -529,409 +548,12 @@ else
fi
-# SCCS: @(#) configure.in 1.90 97/11/20 12:45:45
-
-# CYGNUS LOCAL tromey - find config.guess/config.sub in our tree
-ac_aux_dir=
-for ac_dir in $srcdir/../.. $srcdir/$srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { echo "configure: error: can not find install-sh or install.sh in $srcdir/../.. $srcdir/$srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess=$ac_aux_dir/config.guess
-ac_config_sub=$ac_aux_dir/config.sub
-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
-
-
-# Do some error checking and defaulting for the host and target type.
-# The inputs are:
-# configure --host=HOST --target=TARGET --build=BUILD NONOPT
-#
-# The rules are:
-# 1. You are not allowed to specify --host, --target, and nonopt at the
-# same time.
-# 2. Host defaults to nonopt.
-# 3. If nonopt is not specified, then host defaults to the current host,
-# as determined by config.guess.
-# 4. Target and build default to nonopt.
-# 5. If nonopt is not specified, then target and build default to host.
-
-# The aliases save the names the user supplied, while $host etc.
-# will get canonicalized.
-case $host---$target---$nonopt in
-NONE---*---* | *---NONE---* | *---*---NONE) ;;
-*) { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } ;;
-esac
-
-
-# Make sure we can run config.sub.
-if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
-else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
-fi
-
-echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:583: checking host system type" >&5
-
-host_alias=$host
-case "$host_alias" in
-NONE)
- case $nonopt in
- NONE)
- if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
- else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
- fi ;;
- *) host_alias=$nonopt ;;
- esac ;;
-esac
-
-host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
-host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$host" 1>&6
-
-echo $ac_n "checking target system type""... $ac_c" 1>&6
-echo "configure:604: checking target system type" >&5
-
-target_alias=$target
-case "$target_alias" in
-NONE)
- case $nonopt in
- NONE) target_alias=$host_alias ;;
- *) target_alias=$nonopt ;;
- esac ;;
-esac
-
-target=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $target_alias`
-target_cpu=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-target_vendor=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-target_os=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$target" 1>&6
-
-echo $ac_n "checking build system type""... $ac_c" 1>&6
-echo "configure:622: checking build system type" >&5
-
-build_alias=$build
-case "$build_alias" in
-NONE)
- case $nonopt in
- NONE) build_alias=$host_alias ;;
- *) build_alias=$nonopt ;;
- esac ;;
-esac
-
-build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias`
-build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$build" 1>&6
-
-test "$host_alias" != "$target_alias" &&
- test "$program_prefix$program_suffix$program_transform_name" = \
- NONENONEs,x,x, &&
- program_prefix=${target_alias}-
-
-# Extract the first word of "gcc", so it can be a program name with args.
-set dummy gcc; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:647: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_CC="gcc"
- break
- fi
- done
- IFS="$ac_save_ifs"
-fi
-fi
-CC="$ac_cv_prog_CC"
-if test -n "$CC"; then
- echo "$ac_t""$CC" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
-
-if test -z "$CC"; then
- # Extract the first word of "cc", so it can be a program name with args.
-set dummy cc; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:677: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_prog_rejected=no
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
- ac_prog_rejected=yes
- continue
- fi
- ac_cv_prog_CC="cc"
- break
- fi
- done
- IFS="$ac_save_ifs"
-if test $ac_prog_rejected = yes; then
- # We found a bogon in the path, so make sure we never use it.
- set dummy $ac_cv_prog_CC
- shift
- if test $# -gt 0; then
- # We chose a different compiler from the bogus one.
- # However, it has the same basename, so the bogon will be chosen
- # first if we set CC to just the basename; use the full file name.
- shift
- set dummy "$ac_dir/$ac_word" "$@"
- shift
- ac_cv_prog_CC="$@"
- fi
-fi
-fi
-fi
-CC="$ac_cv_prog_CC"
-if test -n "$CC"; then
- echo "$ac_t""$CC" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
-
- if test -z "$CC"; then
- case "`uname -s`" in
- *win32* | *WIN32*)
- # Extract the first word of "cl", so it can be a program name with args.
-set dummy cl; ac_word=$2
-echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:728: checking for $ac_word" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- if test -n "$CC"; then
- ac_cv_prog_CC="$CC" # Let the user override the test.
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- ac_dummy="$PATH"
- for ac_dir in $ac_dummy; do
- test -z "$ac_dir" && ac_dir=.
- if test -f $ac_dir/$ac_word; then
- ac_cv_prog_CC="cl"
- break
- fi
- done
- IFS="$ac_save_ifs"
-fi
-fi
-CC="$ac_cv_prog_CC"
-if test -n "$CC"; then
- echo "$ac_t""$CC" 1>&6
-else
- echo "$ac_t""no" 1>&6
-fi
- ;;
- esac
- fi
- test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
-fi
-
-echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:760: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
-
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-cat > conftest.$ac_ext << EOF
-
-#line 771 "configure"
-#include "confdefs.h"
-
-main(){return(0);}
-EOF
-if { (eval echo configure:776: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
- ac_cv_prog_cc_works=yes
- # If we can't run a trivial program, we are probably using a cross compiler.
- if (./conftest; exit) 2>/dev/null; then
- ac_cv_prog_cc_cross=no
- else
- ac_cv_prog_cc_cross=yes
- fi
-else
- echo "configure: failed program was:" >&5
- cat conftest.$ac_ext >&5
- ac_cv_prog_cc_works=no
-fi
-rm -fr conftest*
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
-if test $ac_cv_prog_cc_works = no; then
- { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
-fi
-echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:802: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
-echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
-cross_compiling=$ac_cv_prog_cc_cross
-
-echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:807: checking whether we are using GNU C" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- cat > conftest.c <<EOF
-#ifdef __GNUC__
- yes;
-#endif
-EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:816: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
- ac_cv_prog_gcc=yes
-else
- ac_cv_prog_gcc=no
-fi
-fi
-
-echo "$ac_t""$ac_cv_prog_gcc" 1>&6
-
-if test $ac_cv_prog_gcc = yes; then
- GCC=yes
-else
- GCC=
-fi
-
-ac_test_CFLAGS="${CFLAGS+set}"
-ac_save_CFLAGS="$CFLAGS"
-CFLAGS=
-echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
-echo "configure:835: checking whether ${CC-cc} accepts -g" >&5
-if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- echo 'void f(){}' > conftest.c
-if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
- ac_cv_prog_cc_g=yes
-else
- ac_cv_prog_cc_g=no
-fi
-rm -f conftest*
-
-fi
-
-echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
-if test "$ac_test_CFLAGS" = set; then
- CFLAGS="$ac_save_CFLAGS"
-elif test $ac_cv_prog_cc_g = yes; then
- if test "$GCC" = yes; then
- CFLAGS="-g -O2"
- else
- CFLAGS="-g"
- fi
-else
- if test "$GCC" = yes; then
- CFLAGS="-O2"
- else
- CFLAGS=
- fi
-fi
-
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
-echo "configure:878: checking for a BSD compatible install" >&5
-if test -z "$INSTALL"; then
-if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&6
-else
- IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
- for ac_dir in $PATH; do
- # Account for people who put trailing slashes in PATH elements.
- case "$ac_dir/" in
- /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- if test -f $ac_dir/$ac_prog; then
- if test $ac_prog = install &&
- grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- else
- ac_cv_path_install="$ac_dir/$ac_prog -c"
- break 2
- fi
- fi
- done
- ;;
- esac
- done
- IFS="$ac_save_IFS"
-
-fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL="$ac_cv_path_install"
- else
- # As a last resort, use the slow shell script. We don't cache a
- # path for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the path is relative.
- INSTALL="$ac_install_sh"
- fi
-fi
-echo "$ac_t""$INSTALL" 1>&6
+# RCS: @(#) $Id$
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-# END CYGNUS LOCAL
-
-TK_VERSION=8.0
+TK_VERSION=8.3
TK_MAJOR_VERSION=8
-TK_MINOR_VERSION=0
-TK_PATCH_LEVEL=".4"
+TK_MINOR_VERSION=3
+TK_PATCH_LEVEL=".2"
VERSION=${TK_VERSION}
if test "${prefix}" = "NONE"; then
@@ -940,12 +562,42 @@ fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-TK_SRC_DIR=`cd $srcdir/..; pwd`
+# Make sure srcdir is fully qualified!
+srcdir=`cd $srcdir ; pwd`
+
+ val="`cd $srcdir/..; pwd`"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_SRC_DIR" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_SRC_DIR=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_SRC_DIR="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_SRC_DIR=$val
+ ;;
+ esac
+
# Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:949: checking for $ac_word" >&5
+echo "configure:601: 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
@@ -972,19 +624,10 @@ else
echo "$ac_t""no" 1>&6
fi
-# Check whether --enable-gcc or --disable-gcc was given.
-if test "${enable_gcc+set}" = set; then
- enableval="$enable_gcc"
- tk_ok=$enableval
-else
- tkl_ok=no
-fi
-
-if test "$tk_ok" = "yes"; then
- # Extract the first word of "gcc", so it can be a program name with args.
+# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:988: checking for $ac_word" >&5
+echo "configure:631: 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
@@ -1014,7 +657,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:1018: checking for $ac_word" >&5
+echo "configure:661: 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
@@ -1065,7 +708,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:1069: checking for $ac_word" >&5
+echo "configure:712: 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
@@ -1097,7 +740,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:1101: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:744: 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.
@@ -1108,12 +751,12 @@ cross_compiling=$ac_cv_prog_cc_cross
cat > conftest.$ac_ext << EOF
-#line 1112 "configure"
+#line 755 "configure"
#include "confdefs.h"
main(){return(0);}
EOF
-if { (eval echo configure:1117: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:760: \"$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
@@ -1139,12 +782,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:1143: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:786: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:1148: checking whether we are using GNU C" >&5
+echo "configure:791: 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
@@ -1153,7 +796,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1157: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:800: \"$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
@@ -1172,7 +815,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:1176: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:819: 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
@@ -1203,12 +846,9 @@ else
fi
fi
-else
- CC=${CC-cc}
-fi
echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
-echo "configure:1212: checking how to run the C preprocessor" >&5
+echo "configure:852: checking how to run the C preprocessor" >&5
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
@@ -1223,13 +863,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 1227 "configure"
+#line 867 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1233: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:873: \"$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
:
@@ -1240,13 +880,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -E -traditional-cpp"
cat > conftest.$ac_ext <<EOF
-#line 1244 "configure"
+#line 884 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1250: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:890: \"$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
:
@@ -1257,13 +897,13 @@ else
rm -rf conftest*
CPP="${CC-cc} -nologo -E"
cat > conftest.$ac_ext <<EOF
-#line 1261 "configure"
+#line 901 "configure"
#include "confdefs.h"
#include <assert.h>
Syntax Error
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1267: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:907: \"$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
:
@@ -1291,17 +931,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:1295: checking for $ac_hdr" >&5
+echo "configure:935: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1300 "configure"
+#line 940 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1305: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:945: \"$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*
@@ -1328,73 +968,1612 @@ fi
done
-# set the warning flags depending on whether or not we are using gcc
-if test "${GCC}" = "yes" ; then
- # leave -Wimplicit-int out, the X libs generate so many of these warnings
- # that they obscure everything else.
+#------------------------------------------------------------------------
+# Threads support
+#------------------------------------------------------------------------
+
- CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
+ echo $ac_n "checking for building with threads""... $ac_c" 1>&6
+echo "configure:978: 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"
+ tcl_ok=$enableval
else
- CFLAGS_WARNING=""
+ tcl_ok=no
+fi
+
+
+ if test "$tcl_ok" = "yes"; then
+ echo "$ac_t""yes" 1>&6
+ TCL_THREADS=1
+ cat >> confdefs.h <<\EOF
+#define TCL_THREADS 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _REENTRANT 1
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define _THREAD_SAFE 1
+EOF
+
+ echo $ac_n "checking for pthread_mutex_init in -lpthread""... $ac_c" 1>&6
+echo "configure:1004: 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
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1012 "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 pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1023: \"$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=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "no"; then
+ # Check a little harder for __pthread_mutex_init in the same
+ # library, as some systems hide it there until pthread.h is
+ # defined. We could alternatively do an AC_TRY_COMPILE with
+ # 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:1051: 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
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthread $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1059 "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 __pthread_mutex_init();
+
+int main() {
+__pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1070: \"$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=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthread"
+ else
+ echo $ac_n "checking for pthread_mutex_init in -lpthreads""... $ac_c" 1>&6
+echo "configure:1098: 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
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lpthreads $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1106 "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 pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1117: \"$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=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthreads"
+ else
+ echo $ac_n "checking for pthread_mutex_init in -lc""... $ac_c" 1>&6
+echo "configure:1143: 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
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lc $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1151 "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 pthread_mutex_init();
+
+int main() {
+pthread_mutex_init()
+; return 0; }
+EOF
+if { (eval echo configure:1162: \"$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=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "no"; then
+ TCL_THREADS=0
+ echo "configure: warning: "Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..."" 1>&2
+ fi
+ fi
+ fi
+
+ # Does the pthread-implementation provide
+ # 'pthread_attr_setstacksize' ?
+
+ for ac_func in pthread_attr_setstacksize
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1196: 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 1201 "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:1224: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+ else
+ TCL_THREADS=0
+ echo "$ac_t""no (default)" 1>&6
+ fi
+
+
+#------------------------------------------------------------------------------
+# If we're using GCC, see if the compiler understands -pipe. If so, use it.
+# It makes compiling go faster. (This is only a performance feature.)
+#------------------------------------------------------------------------------
+
+if test -z "$no_pipe"; then
+if test -n "$GCC"; then
+ echo $ac_n "checking if the compiler understands -pipe""... $ac_c" 1>&6
+echo "configure:1262: checking if the compiler understands -pipe" >&5
+ OLDCC="$CC"
+ CC="$CC -pipe"
+ cat > conftest.$ac_ext <<EOF
+#line 1266 "configure"
+#include "confdefs.h"
+
+int main() {
+
+; return 0; }
+EOF
+if { (eval echo configure:1273: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CC="$OLDCC"
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+fi
fi
#--------------------------------------------------------------------
-# See if there was a command-line option for where Tcl is; if
-# not, assume that its top-level directory is a sibling of ours.
+# Find and load the tclConfig.sh file
#--------------------------------------------------------------------
-# Check whether --with-tcl or --without-tcl was given.
+
+ #
+ # Ok, lets find the tcl configuration
+ # First, look for one uninstalled.
+ # the alternative search directory is invoked by --with-tcl
+ #
+
+ 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"
- TCL_BIN_DIR=$withval
+ with_tclconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tcl configuration""... $ac_c" 1>&6
+echo "configure:1308: 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
- TCL_BIN_DIR=`cd ../../tcl/unix; pwd`
+
+
+ # First check to see if --with-tclconfig was specified.
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ # then check for a private Tcl installation
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ../tcl \
+ `ls -dr ../tcl[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
+ if test -f "$i/win/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+
+ # check in a few common install locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+
+ # check in a few other private locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tcl \
+ `ls -dr ${srcdir}/../tcl[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
+ if test -f "$i/win/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+
fi
-if test -z "$TCL_BIN_DIR"; then
- { echo "configure: error: couldn't find Tcl build directory in ../../tcl/unix" 1>&2; exit 1; }
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCL_BIN_DIR="# no Tcl configs found"
+ { echo "configure: error: Can't find Tcl configuration definitions" 1>&2; exit 1; }
+ 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 for existence of $TCL_BIN_DIR/tclConfig.sh""... $ac_c" 1>&6
+echo "configure:1386: 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
+
+ #
+ # The eval is required to do the TCL_DBGX substitution in the
+ # TCL_LIB_FILE variable
+ #
+
+ eval TCL_LIB_FILE=${TCL_LIB_FILE}
+ eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+
+
+
+
+
+
+#--------------------------------------------------------------------
+# Recompute the necessary flags to run the compiler
+#--------------------------------------------------------------------
+
+
+
+ # Step 0.a: Enable 64 bit support?
+
+ echo $ac_n "checking if 64bit support is requested""... $ac_c" 1>&6
+echo "configure:1417: 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"
+ :
+else
+ enableval="no"
fi
-if test ! -d $TCL_BIN_DIR; then
- { echo "configure: error: Tcl directory $TCL_BIN_DIR doesn't exist" 1>&2; exit 1; }
+
+
+ if test "$enableval" = "yes"; then
+ do64bit=yes
+ else
+ do64bit=no
+ fi
+ echo "$ac_t""$do64bit" 1>&6
+
+ # 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:1437: 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"
+ :
+else
+ enableval="no"
fi
-if test ! -f $TCL_BIN_DIR/Makefile; then
- { echo "configure: error: There's no Makefile in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+
+
+ if test "$enableval" = "yes"; then
+ # Force 64bit on with VIS
+ do64bit=yes
+ do64bitVIS=yes
+ else
+ do64bitVIS=no
+ fi
+ echo "$ac_t""$do64bitVIS" 1>&6
+
+ # Step 1: set the variable "system" to hold the name and version number
+ # for the system. This can usually be done via the "uname" command, but
+ # 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:1461: 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
+ system=`uname -s`-`uname -r`
+ if test "$?" -ne 0 ; then
+ echo "$ac_t""unknown (can't find uname command)" 1>&6
+ system=unknown
+ 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'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ echo "$ac_t""$system" 1>&6
+ fi
+ fi
+
+ echo $ac_n "checking if gcc is being used""... $ac_c" 1>&6
+echo "configure:1484: checking if gcc is being used" >&5
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ using_gcc="yes"
+ else
+ using_gcc="no"
+ fi
+
+ echo "$ac_t""$using_gcc ($CC)" 1>&6
+
+ # Step 2: check for existence of -ldl library. This is needed because
+ # Linux can use either -ldl or -ldld for dynamic loading.
+
+ echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
+echo "configure:1497: 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
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1505 "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 dlopen();
+
+int main() {
+dlopen()
+; return 0; }
+EOF
+if { (eval echo configure:1516: \"$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"
-#--------------------------------------------------------------------
-# Read in configuration information generated by Tcl for shared
-# libraries, and arrange for it to be substituted into our
-# Makefile.
-#--------------------------------------------------------------------
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ have_dl=yes
+else
+ echo "$ac_t""no" 1>&6
+have_dl=no
+fi
+
+
+ # Step 3: set configuration options based on system name and version.
+
+ do64bit_ok=no
+ fullSrcDir=`cd $srcdir; pwd`
+ EXTRA_CFLAGS=""
+ TCL_EXPORT_FILE_SUFFIX=""
+ UNSHARED_LIB_SUFFIX=""
+ TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
+ ECHO_VERSION='`echo ${VERSION}`'
+ TCL_LIB_VERSIONS_OK=ok
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ if test "$using_gcc" = "yes" ; then
+ CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
+ else
+ CFLAGS_WARNING=""
+ fi
+ TCL_NEEDS_EXP_FILE=0
+ TCL_BUILD_EXP_FILE=""
+ TCL_EXP_FILE=""
+ # 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:1561: 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
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_AR="ar"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+ echo "$ac_t""$AR" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ STLIB_LD='${AR} cr'
+ case $system in
+ AIX-4.[2-9])
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ echo "$ac_t""Using $CC for compiling with threads" 1>&6
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ AIX-*)
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ echo "$ac_t""Using $CC for compiling with threads" 1>&6
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ LIBOBJS="$LIBOBJS tclLoadAix.o"
+ DL_LIBS="-lld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ BSD/OS-2.1*|BSD/OS-3*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="shlicc -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ BSD/OS-4.*)
+ SHLIB_CFLAGS="-export-dynamic -fPIC"
+ SHLIB_LD="cc -shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ dgux*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+ SHLIB_SUFFIX=".sl"
+ echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
+echo "configure:1661: 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
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-ldld $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1669 "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 shl_load();
+
+int main() {
+shl_load()
+; return 0; }
+EOF
+if { (eval echo configure:1680: \"$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=yes
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=no
+fi
+
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS=""
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LDFLAGS="-Wl,-E"
+ LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ fi
+ ;;
+ IRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ ;;
+ IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "yes" ; then
+ EXTRA_CFLAGS="-mabi=n32"
+ LDFLAGS="-mabi=n32"
+ else
+ case $system in
+ IRIX-6.3)
+ # Use to build 6.2 compatible binaries on 6.3.
+ EXTRA_CFLAGS="-n32 -D_OLD_TERMIOS"
+ ;;
+ *)
+ EXTRA_CFLAGS="-n32"
+ ;;
+ esac
+ LDFLAGS="-n32"
+ fi
+ ;;
+ IRIX64-6.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ Linux*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+
+ # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
+ # when you inline the string and math operations. Turn this off to
+ # get rid of the warnings.
+
+ CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
+
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-rdynamic"
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ else
+ ac_safe=`echo "dld.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for dld.h""... $ac_c" 1>&6
+echo "configure:1776: 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 1781 "configure"
+#include "confdefs.h"
+#include <dld.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1786: \"$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
+
+ SHLIB_LD="ld -shared"
+ DL_OBJS="tclLoadDld.o"
+ DL_LIBS="-ldld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ fi
+ if test "`uname -m`" = "alpha" ; then
+ EXTRA_CFLAGS="-mieee"
+ fi
+ ;;
+ MP-RAS-02*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ MP-RAS-*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NetBSD-*|FreeBSD-[1-2].*|OpenBSD-*)
+ # 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:1841: 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 1846 "configure"
+#include "confdefs.h"
+#include <dlfcn.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1851: \"$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
+
+ # NetBSD/SPARC needs -fPIC, -fpic will not do.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ echo $ac_n "checking for ELF""... $ac_c" 1>&6
+echo "configure:1878: checking for ELF" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 1880 "configure"
+#include "confdefs.h"
+
+#ifdef __ELF__
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ echo "$ac_t""yes" 1>&6
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so'
+else
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+
+fi
+rm -f conftest*
+
+
+else
+ echo "$ac_t""no" 1>&6
+
+ SHLIB_CFLAGS=""
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+
+fi
+
+
+ # FreeBSD doesn't handle version numbers with dots.
+
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ FreeBSD-*)
+ # FreeBSD 3.* and greater have ELF.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NEXTSTEP-*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="cc -nostdlib -r"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadNext.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OS/390-*)
+ CFLAGS_OPTIMIZE="" # Optimizer is buggy
+ cat >> confdefs.h <<\EOF
+#define _OE_SOCKETS 1
+EOF
+ # needed in sys/socket.h
+ ;;
+ OSF1-1.0|OSF1-1.1|OSF1-1.2)
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ SHLIB_LD='ld -R -export :'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadOSF.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -shared"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
+ SHLIB_CFLAGS=""
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ # see pthread_intro(3) for pthread support on osf1, k.furukawa
+ if test "${TCL_THREADS}" = "1" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread"
+ LDFLAGS="-pthread"
+ else
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ fi
+ fi
+
+ ;;
+ RISCos-*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ if test "$using_gcc" = "yes" ; then
+ SHLIB_CFLAGS="-fPIC -melf"
+ LDFLAGS="-melf -Wl,-Bexport"
+ else
+ SHLIB_CFLAGS="-Kpic -belf"
+ LDFLAGS="-belf -Wl,-Bexport"
+ fi
+ SHLIB_LD="ld -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-belf -Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ SINIX*5.4*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ SunOS-4*)
+ SHLIB_CFLAGS="-PIC"
+ SHLIB_LD="ld"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+
+ # SunOS can't handle version numbers with dots in them in library
+ # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
+ # requires an extra version number at the end of .so file names.
+ # So, the library has to have a name like libtcl75.so.1.0
+
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ SunOS-5.[0-6]*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ ;;
+ SunOS-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ LDFLAGS=""
+
+ do64bit_ok=no
+ if test "$do64bit" = "yes" ; then
+ arch=`isainfo`
+ if test "$arch" = "sparcv9 sparc" ; then
+ if test "$using_gcc" = "no" ; then
+ do64bit_ok=yes
+ if test "$do64bitVIS" = "yes" ; then
+ EXTRA_CFLAGS="-xarch=v9a"
+ LDFLAGS="-xarch=v9a"
+ else
+ EXTRA_CFLAGS="-xarch=v9"
+ LDFLAGS="-xarch=v9"
+ fi
+ else
+ echo "configure: warning: "64bit mode not supported with GCC on $system"" 1>&2
+ fi
+ else
+ echo "configure: warning: "64bit mode only supported sparcv9 system"" 1>&2
+ fi
+ fi
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ if test "$using_gcc" = "yes" ; then
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ else
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ fi
+ ;;
+ ULTRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ ;;
+ UNIX_SV* | UnixWare-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
+ # 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:2135: checking for ld accepts -Bexport flag" >&5
+ LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+ cat > conftest.$ac_ext <<EOF
+#line 2138 "configure"
+#include "confdefs.h"
+
+int main() {
+int i;
+; return 0; }
+EOF
+if { (eval echo configure:2145: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ found=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ found=no
+fi
+rm -f conftest*
+ LDFLAGS=$hold_ldflags
+ echo "$ac_t""$found" 1>&6
+ if test $found = yes; then
+ LDFLAGS="-Wl,-Bexport"
+ else
+ LDFLAGS=""
+ fi
+ LD_SEARCH_FLAGS=""
+ ;;
+ esac
+
+ if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then
+ echo "configure: warning: "64bit support being disabled -- don\'t know magic for this platform"" 1>&2
+ fi
+
+ # Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
+ # Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
+ # New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
+ # to determine which of several header files defines the a.out file
+ # format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
+ # support only a file format that is more or less version-7-compatible.
+ # In particular,
+ # - a.out files must begin with `struct exec'.
+ # - the N_TXTOFF on the `struct exec' must compute the seek address
+ # of the text segment
+ # - The `struct exec' must contain a_magic, a_text, a_data, a_bss
+ # and a_entry fields.
+ # The following compilation should succeed if and only if either sys/exec.h
+ # or a.out.h is usable for the purpose.
+ #
+ # Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+ # `struct exec' includes a second header that contains information that
+ # duplicates the v7 fields that are needed.
+
+ if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+ echo $ac_n "checking sys/exec.h""... $ac_c" 1>&6
+echo "configure:2191: checking sys/exec.h" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2193 "configure"
+#include "confdefs.h"
+#include <sys/exec.h>
+int main() {
+
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+
+; return 0; }
+EOF
+if { (eval echo configure:2211: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=usable
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=unusable
+fi
+rm -f conftest*
+ echo "$ac_t""$tcl_ok" 1>&6
+ if test $tcl_ok = usable; then
+ cat >> confdefs.h <<\EOF
+#define USE_SYS_EXEC_H 1
+EOF
+
+ else
+ echo $ac_n "checking a.out.h""... $ac_c" 1>&6
+echo "configure:2229: checking a.out.h" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2231 "configure"
+#include "confdefs.h"
+#include <a.out.h>
+int main() {
+
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+
+; return 0; }
+EOF
+if { (eval echo configure:2249: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=usable
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=unusable
+fi
+rm -f conftest*
+ echo "$ac_t""$tcl_ok" 1>&6
+ if test $tcl_ok = usable; then
+ cat >> confdefs.h <<\EOF
+#define USE_A_OUT_H 1
+EOF
+
+ else
+ echo $ac_n "checking sys/exec_aout.h""... $ac_c" 1>&6
+echo "configure:2267: checking sys/exec_aout.h" >&5
+ cat > conftest.$ac_ext <<EOF
+#line 2269 "configure"
+#include "confdefs.h"
+#include <sys/exec_aout.h>
+int main() {
+
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_midmag == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+
+; return 0; }
+EOF
+if { (eval echo configure:2287: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=usable
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=unusable
+fi
+rm -f conftest*
+ echo "$ac_t""$tcl_ok" 1>&6
+ if test $tcl_ok = usable; then
+ cat >> confdefs.h <<\EOF
+#define USE_SYS_EXEC_AOUT_H 1
+EOF
+
+ else
+ DL_OBJS=""
+ fi
+ fi
+ fi
+ fi
+
+ # Step 5: disable dynamic loading if requested via a command-line switch.
+
+ # Check whether --enable-load or --disable-load was given.
+if test "${enable_load+set}" = set; then
+ enableval="$enable_load"
+ tcl_ok=$enableval
+else
+ tcl_ok=yes
+fi
+
+ if test "$tcl_ok" = "no"; then
+ DL_OBJS=""
+ fi
+
+ if test "x$DL_OBJS" != "x" ; then
+ BUILD_DLTEST="\$(DLTEST_TARGETS)"
+ else
+ echo "Can't figure out how to do dynamic loading or shared libraries"
+ echo "on this system."
+ SHLIB_CFLAGS=""
+ SHLIB_LD=""
+ SHLIB_SUFFIX=""
+ DL_OBJS="tclLoadNone.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ BUILD_DLTEST=""
+ fi
+
+ # If we're running gcc, then change the C flags for compiling shared
+ # libraries to the right flags for gcc, instead of those for the
+ # standard manufacturer compiler.
+
+ if test "$DL_OBJS" != "tclLoadNone.o" ; then
+ if test "$using_gcc" = "yes" ; then
+ case $system in
+ AIX-*)
+ ;;
+ BSD/OS*)
+ ;;
+ IRIX*)
+ ;;
+ NetBSD-*|FreeBSD-*|OpenBSD-*)
+ ;;
+ RISCos-*)
+ ;;
+ SCO_SV-3.2*)
+ ;;
+ ULTRIX-4.*)
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ ;;
+ esac
+ fi
+ fi
+
+ if test "$SHARED_LIB_SUFFIX" = "" ; then
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}${SHLIB_SUFFIX}'
+ fi
+ if test "$UNSHARED_LIB_SUFFIX" = "" ; then
+ UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ fi
+
+# CYGNUS LOCAL
+ TCL_LIB_SUFFIX=.a
+
+# END CYGNUS LOCAL
+
+
+
+
+
+
+
+
+ echo $ac_n "checking for build with symbols""... $ac_c" 1>&6
+echo "configure:2387: 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=g
+ echo "$ac_t""yes" 1>&6
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ echo "$ac_t""no" 1>&6
+ fi
-file=$TCL_BIN_DIR/tclConfig.sh
-. $file
-SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
-SHLIB_LD=$TCL_SHLIB_LD
-SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
-SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
-SHLIB_VERSION=$TCL_SHLIB_VERSION
-DL_LIBS=$TCL_DL_LIBS
-LD_FLAGS=$TCL_LD_FLAGS
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_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:2430: 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 2435 "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:2458: \"$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:2479: 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 2487 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2494: \"$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:2525: 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 2533 "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:2544: \"$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).
+# Supply a substitute for stdlib.h if it doesn't define strtol,
+# strtoul, or strtod (which it doesn't in some versions of SunOS).
#--------------------------------------------------------------------
echo $ac_n "checking stdlib.h""... $ac_c" 1>&6
-echo "configure:1396: checking stdlib.h" >&5
+echo "configure:2575: checking stdlib.h" >&5
cat > conftest.$ac_ext <<EOF
-#line 1398 "configure"
+#line 2577 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1409,7 +2588,7 @@ fi
rm -f conftest*
cat > conftest.$ac_ext <<EOF
-#line 1413 "configure"
+#line 2592 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1423,7 +2602,7 @@ fi
rm -f conftest*
cat > conftest.$ac_ext <<EOF
-#line 1427 "configure"
+#line 2606 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1445,26 +2624,26 @@ fi
echo "$ac_t""$tk_ok" 1>&6
#--------------------------------------------------------------------
-# Include sys/select.h if it exists and if it supplies things
-# that appear to be useful and aren't already in sys/types.h.
-# This appears to be true only on the RS/6000 under AIX. Some
-# systems like OSF/1 have a sys/select.h that's of no use, and
-# other systems like SCO UNIX have a sys/select.h that's
-# pernicious. If "fd_set" isn't defined anywhere then set a
-# special flag.
+# Include sys/select.h if it exists and if it supplies things
+# that appear to be useful and aren't already in sys/types.h.
+# This appears to be true only on the RS/6000 under AIX. Some
+# systems like OSF/1 have a sys/select.h that's of no use, and
+# other systems like SCO UNIX have a sys/select.h that's
+# pernicious. If "fd_set" isn't defined anywhere then set a
+# special flag.
#--------------------------------------------------------------------
echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6
-echo "configure:1459: checking fd_set and sys/select" >&5
+echo "configure:2638: checking fd_set and sys/select" >&5
cat > conftest.$ac_ext <<EOF
-#line 1461 "configure"
+#line 2640 "configure"
#include "confdefs.h"
#include <sys/types.h>
int main() {
fd_set readMask, writeMask;
; return 0; }
EOF
-if { (eval echo configure:1468: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2647: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
tk_ok=yes
else
@@ -1476,7 +2655,7 @@ fi
rm -f conftest*
if test $tk_ok = no; then
cat > conftest.$ac_ext <<EOF
-#line 1480 "configure"
+#line 2659 "configure"
#include "confdefs.h"
#include <sys/select.h>
EOF
@@ -1503,17 +2682,17 @@ EOF
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.
#--------------------------------------------------------------------
echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
-echo "configure:1512: checking for ANSI C header files" >&5
+echo "configure:2691: checking for ANSI C header files" >&5
if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1517 "configure"
+#line 2696 "configure"
#include "confdefs.h"
#include <stdlib.h>
#include <stdarg.h>
@@ -1521,7 +2700,7 @@ else
#include <float.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1525: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2704: \"$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*
@@ -1538,7 +2717,7 @@ rm -f conftest*
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
cat > conftest.$ac_ext <<EOF
-#line 1542 "configure"
+#line 2721 "configure"
#include "confdefs.h"
#include <string.h>
EOF
@@ -1556,7 +2735,7 @@ fi
if test $ac_cv_header_stdc = yes; then
# ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
cat > conftest.$ac_ext <<EOF
-#line 1560 "configure"
+#line 2739 "configure"
#include "confdefs.h"
#include <stdlib.h>
EOF
@@ -1577,7 +2756,7 @@ if test "$cross_compiling" = yes; then
:
else
cat > conftest.$ac_ext <<EOF
-#line 1581 "configure"
+#line 2760 "configure"
#include "confdefs.h"
#include <ctype.h>
#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
@@ -1588,7 +2767,7 @@ if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
exit (0); }
EOF
-if { (eval echo configure:1592: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:2771: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
:
else
@@ -1612,12 +2791,12 @@ EOF
fi
echo $ac_n "checking for mode_t""... $ac_c" 1>&6
-echo "configure:1616: checking for mode_t" >&5
+echo "configure:2795: checking for mode_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1621 "configure"
+#line 2800 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -1645,12 +2824,12 @@ EOF
fi
echo $ac_n "checking for pid_t""... $ac_c" 1>&6
-echo "configure:1649: checking for pid_t" >&5
+echo "configure:2828: checking for pid_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1654 "configure"
+#line 2833 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -1678,12 +2857,12 @@ EOF
fi
echo $ac_n "checking for size_t""... $ac_c" 1>&6
-echo "configure:1682: checking for size_t" >&5
+echo "configure:2861: checking for size_t" >&5
if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1687 "configure"
+#line 2866 "configure"
#include "confdefs.h"
#include <sys/types.h>
#if STDC_HEADERS
@@ -1711,12 +2890,12 @@ EOF
fi
echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
-echo "configure:1715: checking for uid_t in sys/types.h" >&5
+echo "configure:2894: checking for uid_t in sys/types.h" >&5
if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1720 "configure"
+#line 2899 "configure"
#include "confdefs.h"
#include <sys/types.h>
EOF
@@ -1753,17 +2932,17 @@ for ac_hdr in sys/time.h
do
ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "configure:1757: checking for $ac_hdr" >&5
+echo "configure:2936: checking for $ac_hdr" >&5
if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1762 "configure"
+#line 2941 "configure"
#include "confdefs.h"
#include <$ac_hdr>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1767: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:2946: \"$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*
@@ -1790,12 +2969,12 @@ fi
done
echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
-echo "configure:1794: checking whether time.h and sys/time.h may both be included" >&5
+echo "configure:2973: checking whether time.h and sys/time.h may both be included" >&5
if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 1799 "configure"
+#line 2978 "configure"
#include "confdefs.h"
#include <sys/types.h>
#include <sys/time.h>
@@ -1804,7 +2983,7 @@ int main() {
struct tm *tp;
; return 0; }
EOF
-if { (eval echo configure:1808: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:2987: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
rm -rf conftest*
ac_cv_header_time=yes
else
@@ -1825,6 +3004,38 @@ 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:3013: checking pw_gecos in struct pwd" >&5
+cat > conftest.$ac_ext <<EOF
+#line 3015 "configure"
+#include "confdefs.h"
+#include <pwd.h>
+int main() {
+struct passwd pwd; pwd.pw_gecos;
+; return 0; }
+EOF
+if { (eval echo configure:3022: \"$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
@@ -1834,12 +3045,13 @@ fi
# 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
+
+ # If we find X, set shell vars x_includes and x_libraries to the
# paths, otherwise set no_x=yes.
# Uses ac_ vars as temps to allow command line to override cache and checks.
# --without-x overrides everything else, but does not touch the cache.
echo $ac_n "checking for X""... $ac_c" 1>&6
-echo "configure:1843: checking for X" >&5
+echo "configure:3055: checking for X" >&5
# Check whether --with-x or --without-x was given.
if test "${with_x+set}" = set; then
@@ -1901,12 +3113,12 @@ if test "$ac_x_includes" = NO; then
# First, try using that file with no special directory specified.
cat > conftest.$ac_ext <<EOF
-#line 1905 "configure"
+#line 3117 "configure"
#include "confdefs.h"
#include <$x_direct_test_include>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1910: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3122: \"$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*
@@ -1975,14 +3187,14 @@ if test "$ac_x_libraries" = NO; then
ac_save_LIBS="$LIBS"
LIBS="-l$x_direct_test_library $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 1979 "configure"
+#line 3191 "configure"
#include "confdefs.h"
int main() {
${x_direct_test_function}()
; return 0; }
EOF
-if { (eval echo configure:1986: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3198: \"$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.
@@ -2068,16 +3280,16 @@ else
echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
fi
-not_really_there=""
-if test "$no_x" = ""; then
- if test "$x_includes" = ""; then
- cat > conftest.$ac_ext <<EOF
-#line 2076 "configure"
+ not_really_there=""
+ if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ cat > conftest.$ac_ext <<EOF
+#line 3288 "configure"
#include "confdefs.h"
#include <X11/XIntrinsic.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2081: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3293: \"$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
:
@@ -2089,23 +3301,23 @@ else
not_really_there="yes"
fi
rm -f conftest*
- else
- if test ! -r $x_includes/X11/Intrinsic.h; then
- not_really_there="yes"
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
fi
fi
-fi
-if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
- echo $ac_n "checking for X11 header files""... $ac_c" 1>&6
-echo "configure:2101: checking for X11 header files" >&5
- XINCLUDES="# no special path needed"
- cat > conftest.$ac_ext <<EOF
-#line 2104 "configure"
+ 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:3313: checking for X11 header files" >&5
+ XINCLUDES="# no special path needed"
+ cat > conftest.$ac_ext <<EOF
+#line 3316 "configure"
#include "confdefs.h"
#include <X11/Intrinsic.h>
EOF
ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2109: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+{ (eval echo configure:3321: \"$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
:
@@ -2117,51 +3329,51 @@ else
XINCLUDES="nope"
fi
rm -f conftest*
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ echo "$ac_t""$i" 1>&6
+ XINCLUDES=" -I$i"
+ break
+ fi
+ done
+ fi
+ else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+ fi
if test "$XINCLUDES" = nope; then
- 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""couldn't find any!" 1>&6
+ XINCLUDES="# no include files found"
+ fi
+
+ if test "$no_x" = yes; then
+ echo $ac_n "checking for X11 libraries""... $ac_c" 1>&6
+echo "configure:3357: 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
- XINCLUDES=" -I$i"
+ XLIBSW="-L$i -lX11"
+ x_libraries="$i"
break
fi
- done
- fi
-else
- if test "$x_includes" != ""; then
- XINCLUDES=-I$x_includes
+ done
else
- XINCLUDES="# no special path needed"
- fi
-fi
-if test "$XINCLUDES" = nope; then
- echo "$ac_t""couldn't find any!" 1>&6
- XINCLUDES="# no include files found"
-fi
-
-if test "$no_x" = yes; then
- echo $ac_n "checking for X11 libraries""... $ac_c" 1>&6
-echo "configure:2145: checking for X11 libraries" >&5
- XLIBSW=nope
- dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
- for i in $dirs ; do
- if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
- echo "$ac_t""$i" 1>&6
- XLIBSW="-L$i -lX11"
- x_libraries="$i"
- break
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
fi
- done
-else
- if test "$x_libraries" = ""; then
- XLIBSW=-lX11
- else
- XLIBSW="-L$x_libraries -lX11"
fi
-fi
-if test "$XLIBSW" = nope ; then
- echo $ac_n "checking for XCreateWindow in -lXwindow""... $ac_c" 1>&6
-echo "configure:2165: checking for XCreateWindow in -lXwindow" >&5
+ if test "$XLIBSW" = nope ; then
+ echo $ac_n "checking for XCreateWindow in -lXwindow""... $ac_c" 1>&6
+echo "configure:3377: 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
@@ -2169,7 +3381,7 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lXwindow $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 2173 "configure"
+#line 3385 "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
@@ -2180,7 +3392,7 @@ int main() {
XCreateWindow()
; return 0; }
EOF
-if { (eval echo configure:2184: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3396: \"$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
@@ -2200,11 +3412,12 @@ 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
+ 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
@@ -2232,12 +3445,6 @@ fi
# variable LIB_RUNTIME_DIR.
eval "TK_CC_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\""
-TK_LD_SEARCH_FLAGS=`echo ${TK_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"`
-
-# CYGNUS LOCAL: Don't hack TK_LD_SEARCH_FLAGS if SHLIB_LD is gcc.
-case "${SHLIB_LD}" in
- *gcc*) TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}" ;;
-esac
#
# CYGNUS LOCAL: statically link on Solaris, HPUX & SunOS so that
@@ -2288,11 +3495,8 @@ esac
fi
;;
#
-# gdb linked statically w/ SunOS or HPUX, but not hpux11 wide
+# gdb linked statically w/ SunOS or HPUX
#
- hppa*w-hp-hpux*)
- ;;
-
m68k-hp-hpux*|hppa*-hp-hpux*|sparc-sun-sunos*)
if test "x$x_libraries" != "x" ;
then
@@ -2311,6 +3515,18 @@ esac
#
# END CYGNUS LOCAL
+# The following case handles the differences between linking with "ld"
+# and the compiler
+
+case $SHLIB_LD in
+ *ld*)
+ TK_LD_SEARCH_FLAGS=`echo ${TK_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"`
+ ;;
+ *)
+ TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}"
+ ;;
+esac
+
#--------------------------------------------------------------------
# Check for the existence of various libraries. The order here
# is important, so that then end up in the right order in the
@@ -2330,7 +3546,7 @@ esac
#--------------------------------------------------------------------
echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6
-echo "configure:2334: checking for main in -lXbsd" >&5
+echo "configure:3550: 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
@@ -2338,14 +3554,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lXbsd $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 2342 "configure"
+#line 3558 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:2349: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3565: \"$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
@@ -2369,7 +3585,7 @@ fi
# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
# mess up the cache values of the functions we check for.
echo $ac_n "checking for socket libraries""... $ac_c" 1>&6
-echo "configure:2373: checking for socket libraries" >&5
+echo "configure:3589: checking for socket libraries" >&5
if eval "test \"`echo '$''{'tcl_cv_lib_sockets'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -2377,12 +3593,12 @@ else
tk_checkBoth=0
unset ac_cv_func_connect
echo $ac_n "checking for connect""... $ac_c" 1>&6
-echo "configure:2381: checking for connect" >&5
+echo "configure:3597: checking for connect" >&5
if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2386 "configure"
+#line 3602 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char connect(); below. */
@@ -2405,7 +3621,7 @@ connect();
; return 0; }
EOF
-if { (eval echo configure:2409: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3625: \"$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
@@ -2428,7 +3644,7 @@ fi
if test "$tk_checkSocket" = 1; then
unset ac_cv_func_connect
echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
-echo "configure:2432: checking for main in -lsocket" >&5
+echo "configure:3648: 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
@@ -2436,14 +3652,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lsocket $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 2440 "configure"
+#line 3656 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:2447: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3663: \"$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
@@ -2470,12 +3686,12 @@ fi
LIBS="$LIBS -lsocket -lnsl"
unset ac_cv_func_accept
echo $ac_n "checking for accept""... $ac_c" 1>&6
-echo "configure:2474: checking for accept" >&5
+echo "configure:3690: checking for accept" >&5
if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2479 "configure"
+#line 3695 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char accept(); below. */
@@ -2498,7 +3714,7 @@ accept();
; return 0; }
EOF
-if { (eval echo configure:2502: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3718: \"$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
@@ -2525,12 +3741,12 @@ fi
tk_oldLibs=$LIBS
LIBS="$LIBS $tk_cv_lib_sockets"
echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
-echo "configure:2529: checking for gethostbyname" >&5
+echo "configure:3745: checking for gethostbyname" >&5
if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2534 "configure"
+#line 3750 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char gethostbyname(); below. */
@@ -2553,7 +3769,7 @@ gethostbyname();
; return 0; }
EOF
-if { (eval echo configure:2557: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3773: \"$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
@@ -2571,7 +3787,7 @@ if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
else
echo "$ac_t""no" 1>&6
echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
-echo "configure:2575: checking for main in -lnsl" >&5
+echo "configure:3791: 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
@@ -2579,14 +3795,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lnsl $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 2583 "configure"
+#line 3799 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:2590: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3806: \"$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
@@ -2616,6 +3832,10 @@ fi
echo "$ac_t""$tcl_cv_lib_sockets" 1>&6
test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+# Add the threads support libraries
+
+LIBS="$LIBS$THREADS_LIBS"
+
#--------------------------------------------------------------------
# One more check related to the X libraries. The standard releases
# of Ultrix don't support the "xauth" mechanism, so send won't work
@@ -2629,13 +3849,13 @@ test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
if test -d /usr/include/mit ; then
echo $ac_n "checking MIT X libraries""... $ac_c" 1>&6
-echo "configure:2633: checking MIT X libraries" >&5
+echo "configure:3853: checking MIT X libraries" >&5
tk_oldCFlags=$CFLAGS
CFLAGS="$CFLAGS -I/usr/include/mit"
tk_oldLibs=$LIBS
LIBS="$LIBS -lX11-mit"
cat > conftest.$ac_ext <<EOF
-#line 2639 "configure"
+#line 3859 "configure"
#include "confdefs.h"
#include <X11/Xlib.h>
@@ -2646,7 +3866,7 @@ int main() {
; return 0; }
EOF
-if { (eval echo configure:2650: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3870: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
rm -rf conftest*
echo "$ac_t""yes" 1>&6
@@ -2673,12 +3893,12 @@ fi
MATH_LIBS=""
echo $ac_n "checking for sin""... $ac_c" 1>&6
-echo "configure:2677: checking for sin" >&5
+echo "configure:3897: checking for sin" >&5
if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2682 "configure"
+#line 3902 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char sin(); below. */
@@ -2701,7 +3921,7 @@ sin();
; return 0; }
EOF
-if { (eval echo configure:2705: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3925: \"$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
@@ -2722,7 +3942,7 @@ MATH_LIBS="-lm"
fi
echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
-echo "configure:2726: checking for main in -lieee" >&5
+echo "configure:3946: 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
@@ -2730,14 +3950,14 @@ else
ac_save_LIBS="$LIBS"
LIBS="-lieee $LIBS"
cat > conftest.$ac_ext <<EOF
-#line 2734 "configure"
+#line 3954 "configure"
#include "confdefs.h"
int main() {
main()
; return 0; }
EOF
-if { (eval echo configure:2741: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:3961: \"$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
@@ -2764,14 +3984,14 @@ fi
#--------------------------------------------------------------------
echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
-echo "configure:2768: checking whether char is unsigned" >&5
+echo "configure:3988: checking whether char is unsigned" >&5
if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
if test "$GCC" = yes; then
# GCC predefines this symbol on systems where it applies.
cat > conftest.$ac_ext <<EOF
-#line 2775 "configure"
+#line 3995 "configure"
#include "confdefs.h"
#ifdef __CHAR_UNSIGNED__
yes
@@ -2793,7 +4013,7 @@ if test "$cross_compiling" = yes; then
{ echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
else
cat > conftest.$ac_ext <<EOF
-#line 2797 "configure"
+#line 4017 "configure"
#include "confdefs.h"
/* volatile prevents gcc2 from optimizing the test away on sparcs. */
#if !defined(__STDC__) || __STDC__ != 1
@@ -2803,7 +4023,7 @@ main() {
volatile char c = 255; exit(c < 0);
}
EOF
-if { (eval echo configure:2807: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:4027: \"$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
@@ -2834,13 +4054,14 @@ fi
# "fixstrtod" (provided by Tcl) that corrects the error.
#--------------------------------------------------------------------
-echo $ac_n "checking for strtod""... $ac_c" 1>&6
-echo "configure:2839: checking for strtod" >&5
+
+ echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:4060: checking for strtod" >&5
if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
cat > conftest.$ac_ext <<EOF
-#line 2844 "configure"
+#line 4065 "configure"
#include "confdefs.h"
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char strtod(); below. */
@@ -2863,7 +4084,7 @@ strtod();
; return 0; }
EOF
-if { (eval echo configure:2867: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:4088: \"$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
@@ -2877,111 +4098,654 @@ fi
if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
echo "$ac_t""yes" 1>&6
- tk_strtod=1
+ tcl_strtod=1
else
echo "$ac_t""no" 1>&6
-tk_strtod=0
+tcl_strtod=0
fi
-if test "$tk_strtod" = 1; then
- echo $ac_n "checking for Solaris 2.4 strtod bug""... $ac_c" 1>&6
-echo "configure:2889: checking for Solaris 2.4 strtod bug" >&5
- if test "$cross_compiling" = yes; then
- tk_ok=0
+ if test "$tcl_strtod" = 1; then
+ echo $ac_n "checking for Solaris2.4/Tru64 strtod bugs""... $ac_c" 1>&6
+echo "configure:4110: checking for Solaris2.4/Tru64 strtod bugs" >&5
+ if test "$cross_compiling" = yes; then
+ tcl_ok=0
else
cat > conftest.$ac_ext <<EOF
-#line 2894 "configure"
+#line 4115 "configure"
#include "confdefs.h"
- extern double strtod();
- int main()
- {
- char *string = "NaN";
- char *term;
- strtod(string, &term);
- if ((term != string) && (term[-1] == 0)) {
- exit(1);
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN", *spaceString = " ";
+ char *term;
+ double value;
+ value = strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
}
- exit(0);
- }
EOF
-if { (eval echo configure:2909: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+if { (eval echo configure:4135: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
then
- tk_ok=1
+ tcl_ok=1
else
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
rm -fr conftest*
- tk_ok=0
+ tcl_ok=0
fi
rm -fr conftest*
fi
- if test "$tk_ok" = 1; then
- echo "$ac_t""ok" 1>&6
- else
- echo "$ac_t""buggy" 1>&6
- cat >> confdefs.h <<\EOF
+ if test "$tcl_ok" = 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
-fi
+
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------
-# Check whether --enable-shared or --disable-shared was given.
+
+ echo $ac_n "checking how to build libraries""... $ac_c" 1>&6
+echo "configure:4167: 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"
- ok=$enableval
+ tcl_ok=$enableval
else
- ok=no
+ tcl_ok=no
fi
-# CYGNUS LOCAL: on machines where static linking of libX11 is important,
-# it is also important to build a static libtk.
-if test -n "$suppress_enable_shared"; then
- ok=no
-fi
-# END CYGNUS LOCAL
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=no
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ echo "$ac_t""shared" 1>&6
+ SHARED_BUILD=1
+ else
+ echo "$ac_t""static" 1>&6
+ SHARED_BUILD=0
+ cat >> confdefs.h <<\EOF
+#define STATIC_BUILD 1
+EOF
-TK_SHARED_LIB_FILE=
-TK_UNSHARED_LIB_FILE=
-if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
- TK_SHARED_BUILD=1
+ fi
+
+
+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
TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
- eval "TK_LIB_FILE=libtk${TCL_SHARED_LIB_SUFFIX}"
- TK_SHARED_LIB_FILE="$TK_LIB_FILE"
- MAKE_LIB="\${SHLIB_LD} -o ${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${SHLIB_LD_LIBS}"
+
+ libname=tk
+ suffix=${TK_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TK_LIB_FILE=$long_libname
+
+ MAKE_LIB="\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_STUB_LIB_SPEC} \${LIBS}"
RANLIB=":"
+
+# TCL_STUB_FLAGS="-DUSE_TCL_STUBS"
+ TCL_STUB_FLAGS=""
else
- TK_SHARED_BUILD=0
TK_SHLIB_CFLAGS=""
- eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
- TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
- MAKE_LIB="ar cr ${TK_LIB_FILE} \${OBJS}"
-fi
+
+ libname=tk
+ suffix=${TK_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
-TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd`"
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TK_LIB_FILE=$long_libname
+
+ MAKE_LIB="\${STLIB_LD} \${TK_LIB_FILE} \${OBJS}"
+
+ TCL_STUB_FLAGS=""
+fi
# Note: in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..": this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TK_BUILD_LIB_SPEC="-L`pwd` -ltk${VERSION}"
- TK_LIB_FLAG="-ltk${VERSION}\${TK_DBGX}"
+if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
+
+ libname=tk
+ version=$TK_VERSION
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TK_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TK_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_BUILD_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_BUILD_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_BUILD_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_BUILD_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_BUILD_LIB_SPEC="-L${dirname} ${TK_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_BUILD_LIB_SPEC="-L`pwd` ${TK_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TK_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_LIB_SPEC="-L${dirname} ${TK_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_LIB_SPEC="-L${exec_prefix}/lib ${TK_LIB_FLAG}"
+ ;;
+ esac
+
+ TK_BUILD_EXP_FILE=""
+ TK_EXP_FILE=""
else
- TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
- TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
+ TK_BUILD_EXP_FILE="lib.exp"
+ eval "TK_EXP_FILE=libtk${TCL_EXPORT_FILE_SUFFIX}"
+
+ TK_BUILD_LIB_SPEC="-bI:`pwd`/${TK_BUILD_EXP_FILE}"
+ TK_LIB_SPEC="-bI:${exec_prefix}/lib/${TK_EXP_FILE}"
fi
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd`"
+
+#--------------------------------------------------------------------
+# 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.
+#--------------------------------------------------------------------
+
+
+ libname=tkstub
+ suffix=${TK_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TK_STUB_LIB_FILE=$long_libname
+
+
+MAKE_STUB_LIB="\${STLIB_LD} \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"
+
+
+ libname=tkstub
+ version=${TK_VERSION}
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TK_STUB_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TK_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_BUILD_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_BUILD_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_BUILD_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_BUILD_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_BUILD_STUB_LIB_SPEC="-L${dirname} ${TK_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_BUILD_STUB_LIB_SPEC="-L`pwd` ${TK_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TK_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_STUB_LIB_SPEC="-L${dirname} ${TK_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TK_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+
+
+ val="`pwd`/${TK_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_BUILD_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_BUILD_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_BUILD_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_BUILD_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+
+ val="`pwd`/${TK_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-TK_LIB_FULL_PATH="`pwd`/${TK_LIB_FILE}"
@@ -3132,7 +4896,6 @@ do
done
ac_given_srcdir=$srcdir
-ac_given_INSTALL="$INSTALL"
trap 'rm -fr `echo "Makefile tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
@@ -3166,57 +4929,67 @@ s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
-s%@host@%$host%g
-s%@host_alias@%$host_alias%g
-s%@host_cpu@%$host_cpu%g
-s%@host_vendor@%$host_vendor%g
-s%@host_os@%$host_os%g
-s%@target@%$target%g
-s%@target_alias@%$target_alias%g
-s%@target_cpu@%$target_cpu%g
-s%@target_vendor@%$target_vendor%g
-s%@target_os@%$target_os%g
-s%@build@%$build%g
-s%@build_alias@%$build_alias%g
-s%@build_cpu@%$build_cpu%g
-s%@build_vendor@%$build_vendor%g
-s%@build_os@%$build_os%g
-s%@CC@%$CC%g
-s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
-s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
-s%@INSTALL_DATA@%$INSTALL_DATA%g
s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
s%@CPP@%$CPP%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%@AR@%$AR%g
+s%@TCL_LIB_SUFFIX@%$TCL_LIB_SUFFIX%g
s%@DL_LIBS@%$DL_LIBS%g
-s%@LD_FLAGS@%$LD_FLAGS%g
+s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
+s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
+s%@CFLAGS_WARNING@%$CFLAGS_WARNING%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%@MAKE_STUB_LIB@%$MAKE_STUB_LIB%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%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
+s%@LDFLAGS_DEFAULT@%$LDFLAGS_DEFAULT%g
+s%@LDFLAGS_DEBUG@%$LDFLAGS_DEBUG%g
+s%@LDFLAGS_OPTIMIZE@%$LDFLAGS_OPTIMIZE%g
+s%@TK_DBGX@%$TK_DBGX%g
+s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%g
s%@MATH_LIBS@%$MATH_LIBS%g
s%@MAKE_LIB@%$MAKE_LIB%g
s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@TK_SHLIB_CFLAGS@%$TK_SHLIB_CFLAGS%g
+s%@STLIB_LD@%$STLIB_LD%g
s%@SHLIB_LD@%$SHLIB_LD%g
s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
s%@SHLIB_VERSION@%$SHLIB_VERSION%g
-s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
-s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_DBGX@%$TCL_DBGX%g
s%@TCL_VERSION@%$TCL_VERSION%g
-s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
s%@TK_CC_SEARCH_FLAGS@%$TK_CC_SEARCH_FLAGS%g
s%@TK_LD_SEARCH_FLAGS@%$TK_LD_SEARCH_FLAGS%g
-s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
s%@TK_LIB_FILE@%$TK_LIB_FILE%g
s%@TK_LIB_FLAG@%$TK_LIB_FLAG%g
s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
s%@TK_MAJOR_VERSION@%$TK_MAJOR_VERSION%g
s%@TK_MINOR_VERSION@%$TK_MINOR_VERSION%g
s%@TK_PATCH_LEVEL@%$TK_PATCH_LEVEL%g
-s%@TK_SHLIB_CFLAGS@%$TK_SHLIB_CFLAGS%g
s%@TK_SRC_DIR@%$TK_SRC_DIR%g
s%@TK_VERSION@%$TK_VERSION%g
s%@XINCLUDES@%$XINCLUDES%g
s%@XLIBSW@%$XLIBSW%g
s%@TK_SHARED_BUILD@%$TK_SHARED_BUILD%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
s%@TK_SHARED_LIB_FILE@%$TK_SHARED_LIB_FILE%g
@@ -3297,10 +5070,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
- case "$ac_given_INSTALL" in
- [/$]*) INSTALL="$ac_given_INSTALL" ;;
- *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
- esac
echo creating "$ac_file"
rm -f "$ac_file"
@@ -3316,7 +5085,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
-s%@INSTALL@%$INSTALL%g
" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
rm -f conftest.s*
@@ -3333,3 +5101,4 @@ chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tk/unix/configure.in b/tk/unix/configure.in
index 49f3f2d4e6a..cdc7eabfe47 100755
--- a/tk/unix/configure.in
+++ b/tk/unix/configure.in
@@ -1,26 +1,20 @@
-! /bin/bash -norc
+#! /bin/bash -norc
dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tk installation
dnl to configure the system for the local environment.
+# RCS: @(#) $Id$
# CYGNUS LOCAL, autoconf 2.5 or higher to get --bindir et al
AC_PREREQ(2.5)
# END CYGNUS LOCAL
AC_INIT(../generic/tk.h)
-# SCCS: @(#) configure.in 1.90 97/11/20 12:45:45
+# RCS: @(#) $Id$
-# CYGNUS LOCAL tromey - find config.guess/config.sub in our tree
-AC_CONFIG_AUX_DIR($srcdir/../..)
-AC_CANONICAL_SYSTEM
-AC_PROG_CC
-AC_PROG_INSTALL
-# END CYGNUS LOCAL
-
-TK_VERSION=8.0
+TK_VERSION=8.3
TK_MAJOR_VERSION=8
-TK_MINOR_VERSION=0
-TK_PATCH_LEVEL=".4"
+TK_MINOR_VERSION=3
+TK_PATCH_LEVEL=".2"
VERSION=${TK_VERSION}
if test "${prefix}" = "NONE"; then
@@ -29,74 +23,94 @@ fi
if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-TK_SRC_DIR=`cd $srcdir/..; pwd`
+# Make sure srcdir is fully qualified!
+srcdir=`cd $srcdir ; pwd`
+TCL_TOOL_PATH(TK_SRC_DIR, "`cd $srcdir/..; pwd`")
AC_PROG_RANLIB
-AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
- [tk_ok=$enableval], [tkl_ok=no])
-if test "$tk_ok" = "yes"; then
- AC_PROG_CC
-else
- CC=${CC-cc}
-AC_SUBST(CC)
-fi
+AC_PROG_CC
+
AC_HAVE_HEADERS(unistd.h limits.h)
-# set the warning flags depending on whether or not we are using gcc
-if test "${GCC}" = "yes" ; then
- # leave -Wimplicit-int out, the X libs generate so many of these warnings
- # that they obscure everything else.
+#------------------------------------------------------------------------
+# Threads support
+#------------------------------------------------------------------------
- CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
-else
- CFLAGS_WARNING=""
+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
+ AC_MSG_CHECKING([if the compiler understands -pipe])
+ OLDCC="$CC"
+ CC="$CC -pipe"
+ AC_TRY_COMPILE(,,
+ AC_MSG_RESULT(yes),
+ CC="$OLDCC"
+ AC_MSG_RESULT(no))
+fi
fi
#--------------------------------------------------------------------
-# See if there was a command-line option for where Tcl is; if
-# not, assume that its top-level directory is a sibling of ours.
+# Find and load the tclConfig.sh file
#--------------------------------------------------------------------
-AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
- TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl/unix; pwd`)
-if test -z "$TCL_BIN_DIR"; then
- AC_MSG_ERROR(couldn't find Tcl build directory in ../../tcl/unix)
-fi
-if test ! -d $TCL_BIN_DIR; then
- AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
-fi
-if test ! -f $TCL_BIN_DIR/Makefile; then
- AC_MSG_ERROR(There's no Makefile in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
-fi
+SC_PATH_TCLCONFIG
+SC_LOAD_TCLCONFIG
#--------------------------------------------------------------------
-# Read in configuration information generated by Tcl for shared
-# libraries, and arrange for it to be substituted into our
-# Makefile.
+# Recompute the necessary flags to run the compiler
#--------------------------------------------------------------------
-file=$TCL_BIN_DIR/tclConfig.sh
-. $file
-SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
-SHLIB_LD=$TCL_SHLIB_LD
-SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
-SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
-SHLIB_VERSION=$TCL_SHLIB_VERSION
-DL_LIBS=$TCL_DL_LIBS
-LD_FLAGS=$TCL_LD_FLAGS
+SC_CONFIG_CFLAGS
+
+SC_ENABLE_SYMBOLS
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_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${TCL_EXEC_PREFIX}/lib"
fi
#--------------------------------------------------------------------
-# Supply a substitute for stdlib.h if it doesn't define strtol,
-# strtoul, or strtod (which it doesn't in some versions of SunOS).
+# 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_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
+AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
+
+#--------------------------------------------------------------------
+# 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
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ 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).
#--------------------------------------------------------------------
AC_MSG_CHECKING(stdlib.h)
@@ -109,13 +123,13 @@ fi
AC_MSG_RESULT($tk_ok)
#--------------------------------------------------------------------
-# Include sys/select.h if it exists and if it supplies things
-# that appear to be useful and aren't already in sys/types.h.
-# This appears to be true only on the RS/6000 under AIX. Some
-# systems like OSF/1 have a sys/select.h that's of no use, and
-# other systems like SCO UNIX have a sys/select.h that's
-# pernicious. If "fd_set" isn't defined anywhere then set a
-# special flag.
+# Include sys/select.h if it exists and if it supplies things
+# that appear to be useful and aren't already in sys/types.h.
+# This appears to be true only on the RS/6000 under AIX. Some
+# systems like OSF/1 have a sys/select.h that's of no use, and
+# other systems like SCO UNIX have a sys/select.h that's
+# pernicious. If "fd_set" isn't defined anywhere then set a
+# special flag.
#--------------------------------------------------------------------
AC_MSG_CHECKING([fd_set and sys/select])
@@ -133,14 +147,14 @@ if test $tk_ok = no; then
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_MODE_T
-AC_PID_T
-AC_SIZE_T
-AC_UID_T
+AC_TYPE_MODE_T
+AC_TYPE_PID_T
+AC_TYPE_SIZE_T
+AC_TYPE_UID_T
#------------------------------------------------------------------------------
# Find out about time handling differences.
@@ -149,6 +163,18 @@ AC_UID_T
AC_CHECK_HEADERS(sys/time.h)
AC_HEADER_TIME
+#-------------------------------------------
+# In OS/390 struct pwd has no pw_gecos field
+#-------------------------------------------
+
+AC_MSG_CHECKING([pw_gecos in struct pwd])
+AC_TRY_COMPILE([#include <pwd.h>],
+ [struct passwd pwd; pwd.pw_gecos;], tk_ok=yes, tk_ok=no)
+AC_MSG_RESULT($tk_ok)
+if test $tk_ok = yes; then
+ AC_DEFINE(HAVE_PW_GECOS)
+fi
+
#--------------------------------------------------------------------
# Locate the X11 header files and the X11 library archive. Try
# the ac_path_x macro first, but if it doesn't find the X stuff
@@ -158,69 +184,7 @@ AC_HEADER_TIME
# no include files, so double-check its result just to be safe.
#--------------------------------------------------------------------
-AC_PATH_X
-not_really_there=""
-if test "$no_x" = ""; then
- if test "$x_includes" = ""; then
- AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes")
- else
- if test ! -r $x_includes/X11/Intrinsic.h; then
- not_really_there="yes"
- fi
- fi
-fi
-if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
- AC_MSG_CHECKING(for X11 header files)
- XINCLUDES="# no special path needed"
- AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
- if test "$XINCLUDES" = nope; then
- dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
- for i in $dirs ; do
- if test -r $i/X11/Intrinsic.h; then
- AC_MSG_RESULT($i)
- XINCLUDES=" -I$i"
- break
- fi
- done
- fi
-else
- if test "$x_includes" != ""; then
- XINCLUDES=-I$x_includes
- else
- XINCLUDES="# no special path needed"
- fi
-fi
-if test "$XINCLUDES" = nope; then
- AC_MSG_RESULT(couldn't find any!)
- XINCLUDES="# no include files found"
-fi
-
-if test "$no_x" = yes; then
- AC_MSG_CHECKING(for X11 libraries)
- XLIBSW=nope
- dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
- for i in $dirs ; do
- if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
- AC_MSG_RESULT($i)
- XLIBSW="-L$i -lX11"
- x_libraries="$i"
- break
- fi
- done
-else
- if test "$x_libraries" = ""; then
- XLIBSW=-lX11
- else
- XLIBSW="-L$x_libraries -lX11"
- fi
-fi
-if test "$XLIBSW" = nope ; then
- AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow)
-fi
-if test "$XLIBSW" = nope ; then
- AC_MSG_RESULT(couldn't find any! Using -lX11.)
- XLIBSW=-lX11
-fi
+SC_PATH_X
#--------------------------------------------------------------------
# Various manipulations on the search path used at runtime to
@@ -248,12 +212,6 @@ fi
# variable LIB_RUNTIME_DIR.
eval "TK_CC_SEARCH_FLAGS=\"$TCL_LD_SEARCH_FLAGS\""
-TK_LD_SEARCH_FLAGS=`echo ${TK_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"`
-
-# CYGNUS LOCAL: Don't hack TK_LD_SEARCH_FLAGS if SHLIB_LD is gcc.
-case "${SHLIB_LD}" in
- *gcc*) TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}" ;;
-esac
#
# CYGNUS LOCAL: statically link on Solaris, HPUX & SunOS so that
@@ -304,11 +262,8 @@ esac
fi
;;
#
-# gdb linked statically w/ SunOS or HPUX, but not hpux11 wide
+# gdb linked statically w/ SunOS or HPUX
#
- hppa*w-hp-hpux*)
- ;;
-
m68k-hp-hpux*|hppa*-hp-hpux*|sparc-sun-sunos*)
if test "x$x_libraries" != "x" ;
then
@@ -327,6 +282,18 @@ esac
#
# END CYGNUS LOCAL
+# The following case handles the differences between linking with "ld"
+# and the compiler
+
+case $SHLIB_LD in
+ *ld*)
+ TK_LD_SEARCH_FLAGS=`echo ${TK_CC_SEARCH_FLAGS} |sed -e "s|-Wl,||g" -e "s|,| |g"`
+ ;;
+ *)
+ TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}"
+ ;;
+esac
+
#--------------------------------------------------------------------
# Check for the existence of various libraries. The order here
# is important, so that then end up in the right order in the
@@ -380,6 +347,10 @@ AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
])
test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+# Add the threads support libraries
+
+LIBS="$LIBS$THREADS_LIBS"
+
#--------------------------------------------------------------------
# One more check related to the X libraries. The standard releases
# of Ultrix don't support the "xauth" mechanism, so send won't work
@@ -435,113 +406,141 @@ AC_C_CHAR_UNSIGNED
# "fixstrtod" (provided by Tcl) that corrects the error.
#--------------------------------------------------------------------
-AC_CHECK_FUNC(strtod, tk_strtod=1, tk_strtod=0)
-if test "$tk_strtod" = 1; then
- AC_MSG_CHECKING([for Solaris 2.4 strtod bug])
- AC_TRY_RUN([
- extern double strtod();
- int main()
- {
- char *string = "NaN";
- char *term;
- strtod(string, &term);
- if ((term != string) && (term[-1] == 0)) {
- exit(1);
- }
- exit(0);
- }], tk_ok=1, tk_ok=0, tk_ok=0)
- if test "$tk_ok" = 1; then
- AC_MSG_RESULT(ok)
- else
- AC_MSG_RESULT(buggy)
- AC_DEFINE(strtod, fixstrtod)
- fi
-fi
+SC_BUGGY_STRTOD
#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtk as a shared library instead of a static library.
#--------------------------------------------------------------------
-AC_ARG_ENABLE(shared,
- [ --enable-shared build libtk as a shared library],
- [ok=$enableval], [ok=no])
+SC_ENABLE_SHARED
-# CYGNUS LOCAL: on machines where static linking of libX11 is important,
-# it is also important to build a static libtk.
-if test -n "$suppress_enable_shared"; then
- ok=no
-fi
-# END CYGNUS LOCAL
+eval eval "TK_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}"
+eval eval "TK_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}"
-TK_SHARED_LIB_FILE=
-TK_UNSHARED_LIB_FILE=
-if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
- TK_SHARED_BUILD=1
+if test "${SHARED_BUILD}" = "1" -a "${SHLIB_SUFFIX}" != ""; then
TK_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
- eval "TK_LIB_FILE=libtk${TCL_SHARED_LIB_SUFFIX}"
- TK_SHARED_LIB_FILE="$TK_LIB_FILE"
- MAKE_LIB="\${SHLIB_LD} -o ${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${SHLIB_LD_LIBS}"
+ TCL_TOOL_SHARED_LIB_LONGNAME(TK_LIB_FILE, tk, ${TK_SHARED_LIB_SUFFIX})
+ MAKE_LIB="\${SHLIB_LD} -o \${TK_LIB_FILE} \${OBJS} \$(TK_LD_SEARCH_FLAGS) ${TCL_STUB_LIB_SPEC} \${LIBS}"
RANLIB=":"
+
+# TCL_STUB_FLAGS="-DUSE_TCL_STUBS"
+ TCL_STUB_FLAGS=""
else
- TK_SHARED_BUILD=0
TK_SHLIB_CFLAGS=""
- eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
- TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
- MAKE_LIB="ar cr ${TK_LIB_FILE} \${OBJS}"
-fi
+ TCL_TOOL_STATIC_LIB_LONGNAME(TK_LIB_FILE, tk, ${TK_UNSHARED_LIB_SUFFIX})
+ MAKE_LIB="\${STLIB_LD} \${TK_LIB_FILE} \${OBJS}"
-dnl CYGNUS LOCAL
-TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd`"
-dnl END CYGNUS LOCAL
+ TCL_STUB_FLAGS=""
+fi
# Note: in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..": this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.
-if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
- TK_BUILD_LIB_SPEC="-L`pwd` -ltk${VERSION}"
- TK_LIB_FLAG="-ltk${VERSION}\${TK_DBGX}"
+if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
+ TCL_TOOL_LIB_SHORTNAME(TK_LIB_FLAG, tk, $TK_VERSION)
+ TCL_TOOL_LIB_SPEC(TK_BUILD_LIB_SPEC, `pwd`, ${TK_LIB_FLAG})
+ TCL_TOOL_LIB_SPEC(TK_LIB_SPEC, ${exec_prefix}/lib, ${TK_LIB_FLAG})
+ TK_BUILD_EXP_FILE=""
+ TK_EXP_FILE=""
else
- TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
- TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
+ TK_BUILD_EXP_FILE="lib.exp"
+ eval "TK_EXP_FILE=libtk${TCL_EXPORT_FILE_SUFFIX}"
+
+ TK_BUILD_LIB_SPEC="-bI:`pwd`/${TK_BUILD_EXP_FILE}"
+ TK_LIB_SPEC="-bI:${exec_prefix}/lib/${TK_EXP_FILE}"
fi
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+dnl CYGNUS LOCAL
+TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd`"
+dnl END CYGNUS LOCAL
-TK_LIB_FULL_PATH="`pwd`/${TK_LIB_FILE}"
+#--------------------------------------------------------------------
+# 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.
+#--------------------------------------------------------------------
+TCL_TOOL_STATIC_LIB_LONGNAME(TK_STUB_LIB_FILE, tkstub, ${TK_UNSHARED_LIB_SUFFIX})
+
+MAKE_STUB_LIB="\${STLIB_LD} \${STUB_LIB_FILE} \${STUB_LIB_OBJS}"
+
+TCL_TOOL_LIB_SHORTNAME(TK_STUB_LIB_FLAG, tkstub, ${TK_VERSION})
+TCL_TOOL_LIB_SPEC(TK_BUILD_STUB_LIB_SPEC, `pwd`, ${TK_STUB_LIB_FLAG})
+TCL_TOOL_LIB_SPEC(TK_STUB_LIB_SPEC, ${exec_prefix}/lib, ${TK_STUB_LIB_FLAG})
+
+TCL_TOOL_LIB_PATH(TK_BUILD_STUB_LIB_PATH, `pwd`, ${TK_STUB_LIB_FILE})
+TCL_TOOL_LIB_PATH(TK_STUB_LIB_PATH, `pwd`, ${TK_STUB_LIB_FILE})
+
+AC_SUBST(TK_STUB_LIB_FILE)
+AC_SUBST(TK_STUB_LIB_FLAG)
+AC_SUBST(TK_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TK_STUB_LIB_SPEC)
+AC_SUBST(TK_BUILD_STUB_LIB_PATH)
+AC_SUBST(TK_STUB_LIB_PATH)
+AC_SUBST(MAKE_STUB_LIB)
+AC_SUBST(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)
+
+AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(CFLAGS_DEBUG)
+AC_SUBST(CFLAGS_OPTIMIZE)
+AC_SUBST(LDFLAGS_DEFAULT)
+AC_SUBST(LDFLAGS_DEBUG)
+AC_SUBST(LDFLAGS_OPTIMIZE)
+AC_SUBST(TK_DBGX)
AC_SUBST(DL_LIBS)
-AC_SUBST(LD_FLAGS)
+AC_SUBST(EXTRA_CFLAGS)
AC_SUBST(MATH_LIBS)
+AC_SUBST(AR)
+AC_SUBST(RANLIB)
AC_SUBST(MAKE_LIB)
AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(TK_SHLIB_CFLAGS)
+AC_SUBST(STLIB_LD)
AC_SUBST(SHLIB_LD)
AC_SUBST(SHLIB_LD_LIBS)
AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(SHLIB_VERSION)
AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(TCL_LIB_SPEC)
+AC_SUBST(TCL_LIB_FLAG)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_DBGX)
+AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_VERSION)
-dnl CYGNUS LOCAL
-AC_SUBST(TK_BUILD_INCLUDES)
-dnl END CYGNUS LOCAL
AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIB_FULL_PATH)
AC_SUBST(TK_CC_SEARCH_FLAGS)
AC_SUBST(TK_LD_SEARCH_FLAGS)
-AC_SUBST(TK_LIB_FULL_PATH)
AC_SUBST(TK_LIB_FILE)
AC_SUBST(TK_LIB_FLAG)
AC_SUBST(TK_LIB_SPEC)
AC_SUBST(TK_MAJOR_VERSION)
AC_SUBST(TK_MINOR_VERSION)
AC_SUBST(TK_PATCH_LEVEL)
-AC_SUBST(TK_SHLIB_CFLAGS)
AC_SUBST(TK_SRC_DIR)
AC_SUBST(TK_VERSION)
AC_SUBST(XINCLUDES)
AC_SUBST(XLIBSW)
AC_SUBST(TK_SHARED_BUILD)
+dnl CYGNUS LOCAL
+AC_SUBST(TK_BUILD_INCLUDES)
+dnl END CYGNUS LOCAL
# CYGNUS LOCAL
# Need more variables to keep shared/static linking separate.
AC_SUBST(TCL_SHARED_LIB_SUFFIX)
@@ -551,3 +550,4 @@ AC_SUBST(TK_UNSHARED_LIB_FILE)
# END CYGNUS LOCAL
AC_OUTPUT(Makefile tkConfig.sh)
+
diff --git a/tk/unix/mkLinks b/tk/unix/mkLinks
index 0bbeb5d05b3..95356941219 100755
--- a/tk/unix/mkLinks
+++ b/tk/unix/mkLinks
@@ -27,169 +27,174 @@ rm xyzzyTe*
if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
exit
fi
+
if test -r 3DBorder.3; then
+ rm -f Tk_Alloc3DBorderFromObj.3
+ rm -f Tk_Get3DBorder.3
+ rm -f Tk_Get3DBorderFromObj.3
+ rm -f Tk_Draw3DRectangle.3
+ rm -f Tk_Fill3DRectangle.3
+ rm -f Tk_Draw3DPolygon.3
+ rm -f Tk_Fill3DPolygon.3
+ rm -f Tk_3DVerticalBevel.3
+ rm -f Tk_3DHorizontalBevel.3
+ rm -f Tk_SetBackgroundFromBorder.3
+ rm -f Tk_NameOf3DBorder.3
rm -f Tk_3DBorderColor.3
- cp 3DBorder.3 Tk_3DBorderColor.3
-fi
-if test -r 3DBorder.3; then
rm -f Tk_3DBorderGC.3
- cp 3DBorder.3 Tk_3DBorderGC.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_3DHorizontalBevel.3
- cp 3DBorder.3 Tk_3DHorizontalBevel.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_3DVerticalBevel.3
+ rm -f Tk_Free3DBorderFromObj.3
+ rm -f Tk_Free3DBorder.3
+ cp 3DBorder.3 Tk_Alloc3DBorderFromObj.3
+ cp 3DBorder.3 Tk_Get3DBorder.3
+ cp 3DBorder.3 Tk_Get3DBorderFromObj.3
+ cp 3DBorder.3 Tk_Draw3DRectangle.3
+ cp 3DBorder.3 Tk_Fill3DRectangle.3
+ cp 3DBorder.3 Tk_Draw3DPolygon.3
+ cp 3DBorder.3 Tk_Fill3DPolygon.3
cp 3DBorder.3 Tk_3DVerticalBevel.3
+ cp 3DBorder.3 Tk_3DHorizontalBevel.3
+ cp 3DBorder.3 Tk_SetBackgroundFromBorder.3
+ cp 3DBorder.3 Tk_NameOf3DBorder.3
+ cp 3DBorder.3 Tk_3DBorderColor.3
+ cp 3DBorder.3 Tk_3DBorderGC.3
+ cp 3DBorder.3 Tk_Free3DBorderFromObj.3
+ cp 3DBorder.3 Tk_Free3DBorder.3
fi
-if test -r WindowId.3; then
- rm -f Tk_Attributes.3
- cp WindowId.3 Tk_Attributes.3
+if test -r AddOption.3; then
+ rm -f Tk_AddOption.3
+ cp AddOption.3 Tk_AddOption.3
fi
if test -r BindTable.3; then
+ rm -f Tk_CreateBindingTable.3
+ rm -f Tk_DeleteBindingTable.3
+ rm -f Tk_CreateBinding.3
+ rm -f Tk_DeleteBinding.3
+ rm -f Tk_GetBinding.3
+ rm -f Tk_GetAllBindings.3
+ rm -f Tk_DeleteAllBindings.3
rm -f Tk_BindEvent.3
+ cp BindTable.3 Tk_CreateBindingTable.3
+ cp BindTable.3 Tk_DeleteBindingTable.3
+ cp BindTable.3 Tk_CreateBinding.3
+ cp BindTable.3 Tk_DeleteBinding.3
+ cp BindTable.3 Tk_GetBinding.3
+ cp BindTable.3 Tk_GetAllBindings.3
+ cp BindTable.3 Tk_DeleteAllBindings.3
cp BindTable.3 Tk_BindEvent.3
fi
-if test -r CanvTkwin.3; then
- rm -f Tk_CanvasDrawableCoords.3
- cp CanvTkwin.3 Tk_CanvasDrawableCoords.3
-fi
-if test -r CanvTkwin.3; then
- rm -f Tk_CanvasEventuallyRedraw.3
- cp CanvTkwin.3 Tk_CanvasEventuallyRedraw.3
-fi
-if test -r CanvTkwin.3; then
- rm -f Tk_CanvasGetCoord.3
- cp CanvTkwin.3 Tk_CanvasGetCoord.3
-fi
if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsY.3
rm -f Tk_CanvasPsBitmap.3
- cp CanvPsY.3 Tk_CanvasPsBitmap.3
-fi
-if test -r CanvPsY.3; then
rm -f Tk_CanvasPsColor.3
- cp CanvPsY.3 Tk_CanvasPsColor.3
-fi
-if test -r CanvPsY.3; then
rm -f Tk_CanvasPsFont.3
- cp CanvPsY.3 Tk_CanvasPsFont.3
-fi
-if test -r CanvPsY.3; then
rm -f Tk_CanvasPsPath.3
- cp CanvPsY.3 Tk_CanvasPsPath.3
-fi
-if test -r CanvPsY.3; then
rm -f Tk_CanvasPsStipple.3
- cp CanvPsY.3 Tk_CanvasPsStipple.3
-fi
-if test -r CanvPsY.3; then
- rm -f Tk_CanvasPsY.3
cp CanvPsY.3 Tk_CanvasPsY.3
+ cp CanvPsY.3 Tk_CanvasPsBitmap.3
+ cp CanvPsY.3 Tk_CanvasPsColor.3
+ cp CanvPsY.3 Tk_CanvasPsFont.3
+ cp CanvPsY.3 Tk_CanvasPsPath.3
+ cp CanvPsY.3 Tk_CanvasPsStipple.3
fi
if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasTkwin.3
+ rm -f Tk_CanvasGetCoord.3
+ rm -f Tk_CanvasDrawableCoords.3
rm -f Tk_CanvasSetStippleOrigin.3
- cp CanvTkwin.3 Tk_CanvasSetStippleOrigin.3
-fi
-if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasWindowCoords.3
+ rm -f Tk_CanvasEventuallyRedraw.3
rm -f Tk_CanvasTagsOption.3
+ cp CanvTkwin.3 Tk_CanvasTkwin.3
+ cp CanvTkwin.3 Tk_CanvasGetCoord.3
+ cp CanvTkwin.3 Tk_CanvasDrawableCoords.3
+ cp CanvTkwin.3 Tk_CanvasSetStippleOrigin.3
+ cp CanvTkwin.3 Tk_CanvasWindowCoords.3
+ cp CanvTkwin.3 Tk_CanvasEventuallyRedraw.3
cp CanvTkwin.3 Tk_CanvasTagsOption.3
fi
if test -r CanvTxtInfo.3; then
rm -f Tk_CanvasTextInfo.3
cp CanvTxtInfo.3 Tk_CanvasTextInfo.3
fi
-if test -r CanvTkwin.3; then
- rm -f Tk_CanvasTkwin.3
- cp CanvTkwin.3 Tk_CanvasTkwin.3
-fi
-if test -r CanvTkwin.3; then
- rm -f Tk_CanvasWindowCoords.3
- cp CanvTkwin.3 Tk_CanvasWindowCoords.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_ChangeWindowAttributes.3
- cp ConfigWind.3 Tk_ChangeWindowAttributes.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_Changes.3
- cp WindowId.3 Tk_Changes.3
-fi
-if test -r TextLayout.3; then
- rm -f Tk_CharBbox.3
- cp TextLayout.3 Tk_CharBbox.3
-fi
-if test -r SetClass.3; then
- rm -f Tk_Class.3
- cp SetClass.3 Tk_Class.3
-fi
-if test -r ClrSelect.3; then
- rm -f Tk_ClearSelection.3
- cp ClrSelect.3 Tk_ClearSelection.3
-fi
-if test -r Clipboard.3; then
- rm -f Tk_ClipboardAppend.3
- cp Clipboard.3 Tk_ClipboardAppend.3
-fi
if test -r Clipboard.3; then
rm -f Tk_ClipboardClear.3
+ rm -f Tk_ClipboardAppend.3
cp Clipboard.3 Tk_ClipboardClear.3
+ cp Clipboard.3 Tk_ClipboardAppend.3
fi
-if test -r WindowId.3; then
- rm -f Tk_Colormap.3
- cp WindowId.3 Tk_Colormap.3
-fi
-if test -r TextLayout.3; then
- rm -f Tk_ComputeTextLayout.3
- cp TextLayout.3 Tk_ComputeTextLayout.3
+if test -r ClrSelect.3; then
+ rm -f Tk_ClearSelection.3
+ cp ClrSelect.3 Tk_ClearSelection.3
fi
if test -r ConfigWidg.3; then
+ rm -f Tk_ConfigureWidget.3
+ rm -f Tk_Offset.3
rm -f Tk_ConfigureInfo.3
- cp ConfigWidg.3 Tk_ConfigureInfo.3
-fi
-if test -r ConfigWidg.3; then
rm -f Tk_ConfigureValue.3
- cp ConfigWidg.3 Tk_ConfigureValue.3
-fi
-if test -r ConfigWidg.3; then
- rm -f Tk_ConfigureWidget.3
+ rm -f Tk_FreeOptions.3
cp ConfigWidg.3 Tk_ConfigureWidget.3
+ cp ConfigWidg.3 Tk_Offset.3
+ cp ConfigWidg.3 Tk_ConfigureInfo.3
+ cp ConfigWidg.3 Tk_ConfigureValue.3
+ cp ConfigWidg.3 Tk_FreeOptions.3
fi
if test -r ConfigWind.3; then
rm -f Tk_ConfigureWindow.3
+ rm -f Tk_MoveWindow.3
+ rm -f Tk_ResizeWindow.3
+ rm -f Tk_MoveResizeWindow.3
+ rm -f Tk_SetWindowBorderWidth.3
+ rm -f Tk_ChangeWindowAttributes.3
+ rm -f Tk_SetWindowBackground.3
+ rm -f Tk_SetWindowBackgroundPixmap.3
+ rm -f Tk_SetWindowBorder.3
+ rm -f Tk_SetWindowBorderPixmap.3
+ rm -f Tk_SetWindowColormap.3
+ rm -f Tk_DefineCursor.3
+ rm -f Tk_UndefineCursor.3
cp ConfigWind.3 Tk_ConfigureWindow.3
+ cp ConfigWind.3 Tk_MoveWindow.3
+ cp ConfigWind.3 Tk_ResizeWindow.3
+ cp ConfigWind.3 Tk_MoveResizeWindow.3
+ cp ConfigWind.3 Tk_SetWindowBorderWidth.3
+ cp ConfigWind.3 Tk_ChangeWindowAttributes.3
+ cp ConfigWind.3 Tk_SetWindowBackground.3
+ cp ConfigWind.3 Tk_SetWindowBackgroundPixmap.3
+ cp ConfigWind.3 Tk_SetWindowBorder.3
+ cp ConfigWind.3 Tk_SetWindowBorderPixmap.3
+ cp ConfigWind.3 Tk_SetWindowColormap.3
+ cp ConfigWind.3 Tk_DefineCursor.3
+ cp ConfigWind.3 Tk_UndefineCursor.3
fi
if test -r CoordToWin.3; then
rm -f Tk_CoordsToWindow.3
cp CoordToWin.3 Tk_CoordsToWindow.3
fi
-if test -r BindTable.3; then
- rm -f Tk_CreateBinding.3
- cp BindTable.3 Tk_CreateBinding.3
-fi
-if test -r BindTable.3; then
- rm -f Tk_CreateBindingTable.3
- cp BindTable.3 Tk_CreateBindingTable.3
-fi
if test -r CrtErrHdlr.3; then
rm -f Tk_CreateErrorHandler.3
+ rm -f Tk_DeleteErrorHandler.3
cp CrtErrHdlr.3 Tk_CreateErrorHandler.3
-fi
-if test -r EventHndlr.3; then
- rm -f Tk_CreateEventHandler.3
- cp EventHndlr.3 Tk_CreateEventHandler.3
+ cp CrtErrHdlr.3 Tk_DeleteErrorHandler.3
fi
if test -r CrtGenHdlr.3; then
rm -f Tk_CreateGenericHandler.3
+ rm -f Tk_DeleteGenericHandler.3
cp CrtGenHdlr.3 Tk_CreateGenericHandler.3
+ cp CrtGenHdlr.3 Tk_DeleteGenericHandler.3
fi
if test -r CrtImgType.3; then
rm -f Tk_CreateImageType.3
+ rm -f Tk_GetImageMasterData.3
+ rm -f Tk_InitImageArgs.3
cp CrtImgType.3 Tk_CreateImageType.3
+ cp CrtImgType.3 Tk_GetImageMasterData.3
+ cp CrtImgType.3 Tk_InitImageArgs.3
fi
if test -r CrtItemType.3; then
rm -f Tk_CreateItemType.3
+ rm -f Tk_GetItemTypes.3
cp CrtItemType.3 Tk_CreateItemType.3
+ cp CrtItemType.3 Tk_GetItemTypes.3
fi
if test -r CrtPhImgFmt.3; then
rm -f Tk_CreatePhotoImageFormat.3
@@ -197,159 +202,59 @@ if test -r CrtPhImgFmt.3; then
fi
if test -r CrtSelHdlr.3; then
rm -f Tk_CreateSelHandler.3
+ rm -f Tk_DeleteSelHandler.3
cp CrtSelHdlr.3 Tk_CreateSelHandler.3
+ cp CrtSelHdlr.3 Tk_DeleteSelHandler.3
fi
if test -r CrtWindow.3; then
rm -f Tk_CreateWindow.3
- cp CrtWindow.3 Tk_CreateWindow.3
-fi
-if test -r CrtWindow.3; then
rm -f Tk_CreateWindowFromPath.3
+ rm -f Tk_DestroyWindow.3
+ rm -f Tk_MakeWindowExist.3
+ cp CrtWindow.3 Tk_CreateWindow.3
cp CrtWindow.3 Tk_CreateWindowFromPath.3
-fi
-if test -r GetBitmap.3; then
- rm -f Tk_DefineBitmap.3
- cp GetBitmap.3 Tk_DefineBitmap.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_DefineCursor.3
- cp ConfigWind.3 Tk_DefineCursor.3
-fi
-if test -r BindTable.3; then
- rm -f Tk_DeleteAllBindings.3
- cp BindTable.3 Tk_DeleteAllBindings.3
-fi
-if test -r BindTable.3; then
- rm -f Tk_DeleteBinding.3
- cp BindTable.3 Tk_DeleteBinding.3
-fi
-if test -r BindTable.3; then
- rm -f Tk_DeleteBindingTable.3
- cp BindTable.3 Tk_DeleteBindingTable.3
-fi
-if test -r CrtErrHdlr.3; then
- rm -f Tk_DeleteErrorHandler.3
- cp CrtErrHdlr.3 Tk_DeleteErrorHandler.3
-fi
-if test -r EventHndlr.3; then
- rm -f Tk_DeleteEventHandler.3
- cp EventHndlr.3 Tk_DeleteEventHandler.3
-fi
-if test -r CrtGenHdlr.3; then
- rm -f Tk_DeleteGenericHandler.3
- cp CrtGenHdlr.3 Tk_DeleteGenericHandler.3
+ cp CrtWindow.3 Tk_DestroyWindow.3
+ cp CrtWindow.3 Tk_MakeWindowExist.3
fi
if test -r DeleteImg.3; then
rm -f Tk_DeleteImage.3
cp DeleteImg.3 Tk_DeleteImage.3
fi
-if test -r CrtSelHdlr.3; then
- rm -f Tk_DeleteSelHandler.3
- cp CrtSelHdlr.3 Tk_DeleteSelHandler.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_Depth.3
- cp WindowId.3 Tk_Depth.3
-fi
-if test -r CrtWindow.3; then
- rm -f Tk_DestroyWindow.3
- cp CrtWindow.3 Tk_DestroyWindow.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_Display.3
- cp WindowId.3 Tk_Display.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_DisplayName.3
- cp WindowId.3 Tk_DisplayName.3
-fi
-if test -r TextLayout.3; then
- rm -f Tk_DistanceToTextLayout.3
- cp TextLayout.3 Tk_DistanceToTextLayout.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_Draw3DPolygon.3
- cp 3DBorder.3 Tk_Draw3DPolygon.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_Draw3DRectangle.3
- cp 3DBorder.3 Tk_Draw3DRectangle.3
-fi
-if test -r MeasureChar.3; then
- rm -f Tk_DrawChars.3
- cp MeasureChar.3 Tk_DrawChars.3
-fi
if test -r DrawFocHlt.3; then
rm -f Tk_DrawFocusHighlight.3
cp DrawFocHlt.3 Tk_DrawFocusHighlight.3
fi
-if test -r TextLayout.3; then
- rm -f Tk_DrawTextLayout.3
- cp TextLayout.3 Tk_DrawTextLayout.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_Fill3DPolygon.3
- cp 3DBorder.3 Tk_Fill3DPolygon.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_Fill3DRectangle.3
- cp 3DBorder.3 Tk_Fill3DRectangle.3
+if test -r EventHndlr.3; then
+ rm -f Tk_CreateEventHandler.3
+ rm -f Tk_DeleteEventHandler.3
+ cp EventHndlr.3 Tk_CreateEventHandler.3
+ cp EventHndlr.3 Tk_DeleteEventHandler.3
fi
if test -r FindPhoto.3; then
rm -f Tk_FindPhoto.3
+ rm -f Tk_PhotoPutBlock.3
+ rm -f Tk_PhotoPutZoomedBlock.3
+ rm -f Tk_PhotoGetImage.3
+ rm -f Tk_PhotoBlank.3
+ rm -f Tk_PhotoExpand.3
+ rm -f Tk_PhotoGetSize.3
+ rm -f Tk_PhotoSetSize.3
cp FindPhoto.3 Tk_FindPhoto.3
+ cp FindPhoto.3 Tk_PhotoPutBlock.3
+ cp FindPhoto.3 Tk_PhotoPutZoomedBlock.3
+ cp FindPhoto.3 Tk_PhotoGetImage.3
+ cp FindPhoto.3 Tk_PhotoBlank.3
+ cp FindPhoto.3 Tk_PhotoExpand.3
+ cp FindPhoto.3 Tk_PhotoGetSize.3
+ cp FindPhoto.3 Tk_PhotoSetSize.3
fi
if test -r FontId.3; then
rm -f Tk_FontId.3
- cp FontId.3 Tk_FontId.3
-fi
-if test -r FontId.3; then
rm -f Tk_FontMetrics.3
+ rm -f Tk_PostscriptFontName.3
+ cp FontId.3 Tk_FontId.3
cp FontId.3 Tk_FontMetrics.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_Free3DBorder.3
- cp 3DBorder.3 Tk_Free3DBorder.3
-fi
-if test -r GetBitmap.3; then
- rm -f Tk_FreeBitmap.3
- cp GetBitmap.3 Tk_FreeBitmap.3
-fi
-if test -r GetColor.3; then
- rm -f Tk_FreeColor.3
- cp GetColor.3 Tk_FreeColor.3
-fi
-if test -r GetClrmap.3; then
- rm -f Tk_FreeColormap.3
- cp GetClrmap.3 Tk_FreeColormap.3
-fi
-if test -r GetCursor.3; then
- rm -f Tk_FreeCursor.3
- cp GetCursor.3 Tk_FreeCursor.3
-fi
-if test -r GetFont.3; then
- rm -f Tk_FreeFont.3
- cp GetFont.3 Tk_FreeFont.3
-fi
-if test -r GetGC.3; then
- rm -f Tk_FreeGC.3
- cp GetGC.3 Tk_FreeGC.3
-fi
-if test -r GetImage.3; then
- rm -f Tk_FreeImage.3
- cp GetImage.3 Tk_FreeImage.3
-fi
-if test -r ConfigWidg.3; then
- rm -f Tk_FreeOptions.3
- cp ConfigWidg.3 Tk_FreeOptions.3
-fi
-if test -r GetPixmap.3; then
- rm -f Tk_FreePixmap.3
- cp GetPixmap.3 Tk_FreePixmap.3
-fi
-if test -r TextLayout.3; then
- rm -f Tk_FreeTextLayout.3
- cp TextLayout.3 Tk_FreeTextLayout.3
+ cp FontId.3 Tk_PostscriptFontName.3
fi
if test -r FreeXId.3; then
rm -f Tk_FreeXId.3
@@ -357,115 +262,175 @@ if test -r FreeXId.3; then
fi
if test -r GeomReq.3; then
rm -f Tk_GeometryRequest.3
+ rm -f Tk_SetInternalBorder.3
cp GeomReq.3 Tk_GeometryRequest.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_Get3DBorder.3
- cp 3DBorder.3 Tk_Get3DBorder.3
-fi
-if test -r BindTable.3; then
- rm -f Tk_GetAllBindings.3
- cp BindTable.3 Tk_GetAllBindings.3
+ cp GeomReq.3 Tk_SetInternalBorder.3
fi
if test -r GetAnchor.3; then
+ rm -f Tk_GetAnchorFromObj.3
rm -f Tk_GetAnchor.3
+ rm -f Tk_NameOfAnchor.3
+ cp GetAnchor.3 Tk_GetAnchorFromObj.3
cp GetAnchor.3 Tk_GetAnchor.3
-fi
-if test -r InternAtom.3; then
- rm -f Tk_GetAtomName.3
- cp InternAtom.3 Tk_GetAtomName.3
-fi
-if test -r BindTable.3; then
- rm -f Tk_GetBinding.3
- cp BindTable.3 Tk_GetBinding.3
+ cp GetAnchor.3 Tk_NameOfAnchor.3
fi
if test -r GetBitmap.3; then
+ rm -f Tk_AllocBitmapFromObj.3
rm -f Tk_GetBitmap.3
- cp GetBitmap.3 Tk_GetBitmap.3
-fi
-if test -r GetBitmap.3; then
+ rm -f Tk_GetBitmapFromObj.3
+ rm -f Tk_DefineBitmap.3
+ rm -f Tk_NameOfBitmap.3
+ rm -f Tk_SizeOfBitmap.3
+ rm -f Tk_FreeBitmapFromObj.3
+ rm -f Tk_FreeBitmap.3
rm -f Tk_GetBitmapFromData.3
+ cp GetBitmap.3 Tk_AllocBitmapFromObj.3
+ cp GetBitmap.3 Tk_GetBitmap.3
+ cp GetBitmap.3 Tk_GetBitmapFromObj.3
+ cp GetBitmap.3 Tk_DefineBitmap.3
+ cp GetBitmap.3 Tk_NameOfBitmap.3
+ cp GetBitmap.3 Tk_SizeOfBitmap.3
+ cp GetBitmap.3 Tk_FreeBitmapFromObj.3
+ cp GetBitmap.3 Tk_FreeBitmap.3
cp GetBitmap.3 Tk_GetBitmapFromData.3
fi
if test -r GetCapStyl.3; then
rm -f Tk_GetCapStyle.3
+ rm -f Tk_NameOfCapStyle.3
cp GetCapStyl.3 Tk_GetCapStyle.3
+ cp GetCapStyl.3 Tk_NameOfCapStyle.3
fi
-if test -r GetColor.3; then
- rm -f Tk_GetColor.3
- cp GetColor.3 Tk_GetColor.3
+if test -r GetClrmap.3; then
+ rm -f Tk_GetColormap.3
+ rm -f Tk_FreeColormap.3
+ cp GetClrmap.3 Tk_GetColormap.3
+ cp GetClrmap.3 Tk_FreeColormap.3
fi
if test -r GetColor.3; then
+ rm -f Tk_AllocColorFromObj.3
+ rm -f Tk_GetColor.3
+ rm -f Tk_GetColorFromObj.3
rm -f Tk_GetColorByValue.3
+ rm -f Tk_NameOfColor.3
+ rm -f Tk_FreeColorFromObj.3
+ rm -f Tk_FreeColor.3
+ cp GetColor.3 Tk_AllocColorFromObj.3
+ cp GetColor.3 Tk_GetColor.3
+ cp GetColor.3 Tk_GetColorFromObj.3
cp GetColor.3 Tk_GetColorByValue.3
-fi
-if test -r GetClrmap.3; then
- rm -f Tk_GetColormap.3
- cp GetClrmap.3 Tk_GetColormap.3
+ cp GetColor.3 Tk_NameOfColor.3
+ cp GetColor.3 Tk_FreeColorFromObj.3
+ cp GetColor.3 Tk_FreeColor.3
fi
if test -r GetCursor.3; then
+ rm -f Tk_AllocCursorFromObj.3
rm -f Tk_GetCursor.3
- cp GetCursor.3 Tk_GetCursor.3
-fi
-if test -r GetCursor.3; then
+ rm -f Tk_GetCursorFromObj.3
rm -f Tk_GetCursorFromData.3
+ rm -f Tk_NameOfCursor.3
+ rm -f Tk_FreeCursorFromObj.3
+ rm -f Tk_FreeCursor.3
+ cp GetCursor.3 Tk_AllocCursorFromObj.3
+ cp GetCursor.3 Tk_GetCursor.3
+ cp GetCursor.3 Tk_GetCursorFromObj.3
cp GetCursor.3 Tk_GetCursorFromData.3
+ cp GetCursor.3 Tk_NameOfCursor.3
+ cp GetCursor.3 Tk_FreeCursorFromObj.3
+ cp GetCursor.3 Tk_FreeCursor.3
+fi
+if test -r GetDash.3; then
+ rm -f Tk_GetDash.3
+ cp GetDash.3 Tk_GetDash.3
fi
if test -r GetFont.3; then
+ rm -f Tk_AllocFontFromObj.3
rm -f Tk_GetFont.3
+ rm -f Tk_GetFontFromObj.3
+ rm -f Tk_NameOfFont.3
+ rm -f Tk_FreeFontFromObj.3
+ rm -f Tk_FreeFont.3
+ cp GetFont.3 Tk_AllocFontFromObj.3
cp GetFont.3 Tk_GetFont.3
+ cp GetFont.3 Tk_GetFontFromObj.3
+ cp GetFont.3 Tk_NameOfFont.3
+ cp GetFont.3 Tk_FreeFontFromObj.3
+ cp GetFont.3 Tk_FreeFont.3
fi
if test -r GetGC.3; then
rm -f Tk_GetGC.3
+ rm -f Tk_FreeGC.3
cp GetGC.3 Tk_GetGC.3
+ cp GetGC.3 Tk_FreeGC.3
+fi
+if test -r GetHINSTANCE.3; then
+ rm -f Tk_GetHINSTANCE.3
+ cp GetHINSTANCE.3 Tk_GetHINSTANCE.3
+fi
+if test -r GetHWND.3; then
+ rm -f Tk_GetHWND.3
+ cp GetHWND.3 Tk_GetHWND.3
fi
if test -r GetImage.3; then
rm -f Tk_GetImage.3
+ rm -f Tk_RedrawImage.3
+ rm -f Tk_SizeOfImage.3
+ rm -f Tk_FreeImage.3
cp GetImage.3 Tk_GetImage.3
-fi
-if test -r CrtImgType.3; then
- rm -f Tk_GetImageMasterData.3
- cp CrtImgType.3 Tk_GetImageMasterData.3
-fi
-if test -r CrtItemType.3; then
- rm -f Tk_GetItemTypes.3
- cp CrtItemType.3 Tk_GetItemTypes.3
+ cp GetImage.3 Tk_RedrawImage.3
+ cp GetImage.3 Tk_SizeOfImage.3
+ cp GetImage.3 Tk_FreeImage.3
fi
if test -r GetJoinStl.3; then
rm -f Tk_GetJoinStyle.3
+ rm -f Tk_NameOfJoinStyle.3
cp GetJoinStl.3 Tk_GetJoinStyle.3
+ cp GetJoinStl.3 Tk_NameOfJoinStyle.3
fi
if test -r GetJustify.3; then
+ rm -f Tk_GetJustifyFromObj.3
rm -f Tk_GetJustify.3
+ rm -f Tk_NameOfJustify.3
+ cp GetJustify.3 Tk_GetJustifyFromObj.3
cp GetJustify.3 Tk_GetJustify.3
+ cp GetJustify.3 Tk_NameOfJustify.3
fi
if test -r GetOption.3; then
rm -f Tk_GetOption.3
cp GetOption.3 Tk_GetOption.3
fi
if test -r GetPixels.3; then
+ rm -f Tk_GetPixelsFromObj.3
rm -f Tk_GetPixels.3
+ rm -f Tk_GetMMFromObj.3
+ rm -f Tk_GetScreenMM.3
+ cp GetPixels.3 Tk_GetPixelsFromObj.3
cp GetPixels.3 Tk_GetPixels.3
+ cp GetPixels.3 Tk_GetMMFromObj.3
+ cp GetPixels.3 Tk_GetScreenMM.3
fi
if test -r GetPixmap.3; then
rm -f Tk_GetPixmap.3
+ rm -f Tk_FreePixmap.3
cp GetPixmap.3 Tk_GetPixmap.3
+ cp GetPixmap.3 Tk_FreePixmap.3
fi
if test -r GetRelief.3; then
+ rm -f Tk_GetReliefFromObj.3
rm -f Tk_GetRelief.3
+ rm -f Tk_NameOfRelief.3
+ cp GetRelief.3 Tk_GetReliefFromObj.3
cp GetRelief.3 Tk_GetRelief.3
+ cp GetRelief.3 Tk_NameOfRelief.3
fi
if test -r GetRootCrd.3; then
rm -f Tk_GetRootCoords.3
cp GetRootCrd.3 Tk_GetRootCoords.3
fi
-if test -r GetPixels.3; then
- rm -f Tk_GetScreenMM.3
- cp GetPixels.3 Tk_GetScreenMM.3
-fi
if test -r GetScroll.3; then
rm -f Tk_GetScrollInfo.3
+ rm -f Tk_GetScrollInfoObj.3
cp GetScroll.3 Tk_GetScrollInfo.3
+ cp GetScroll.3 Tk_GetScrollInfoObj.3
fi
if test -r GetSelect.3; then
rm -f Tk_GetSelection.3
@@ -473,7 +438,9 @@ if test -r GetSelect.3; then
fi
if test -r GetUid.3; then
rm -f Tk_GetUid.3
+ rm -f Tk_Uid.3
cp GetUid.3 Tk_GetUid.3
+ cp GetUid.3 Tk_Uid.3
fi
if test -r GetVRoot.3; then
rm -f Tk_GetVRootGeometry.3
@@ -483,14 +450,20 @@ if test -r GetVisual.3; then
rm -f Tk_GetVisual.3
cp GetVisual.3 Tk_GetVisual.3
fi
+if test -r Grab.3; then
+ rm -f Tk_Grab.3
+ rm -f Tk_Ungrab.3
+ cp Grab.3 Tk_Grab.3
+ cp Grab.3 Tk_Ungrab.3
+fi
+if test -r HWNDToWindow.3; then
+ rm -f Tk_HWNDToWindow.3
+ cp HWNDToWindow.3 Tk_HWNDToWindow.3
+fi
if test -r HandleEvent.3; then
rm -f Tk_HandleEvent.3
cp HandleEvent.3 Tk_HandleEvent.3
fi
-if test -r WindowId.3; then
- rm -f Tk_Height.3
- cp WindowId.3 Tk_Height.3
-fi
if test -r IdToWindow.3; then
rm -f Tk_IdToWindow.3
cp IdToWindow.3 Tk_IdToWindow.3
@@ -501,23 +474,9 @@ if test -r ImgChanged.3; then
fi
if test -r InternAtom.3; then
rm -f Tk_InternAtom.3
+ rm -f Tk_GetAtomName.3
cp InternAtom.3 Tk_InternAtom.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_InternalBorderWidth.3
- cp WindowId.3 Tk_InternalBorderWidth.3
-fi
-if test -r TextLayout.3; then
- rm -f Tk_IntersectTextLayout.3
- cp TextLayout.3 Tk_IntersectTextLayout.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_IsMapped.3
- cp WindowId.3 Tk_IsMapped.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_IsTopLevel.3
- cp WindowId.3 Tk_IsTopLevel.3
+ cp InternAtom.3 Tk_GetAtomName.3
fi
if test -r MainLoop.3; then
rm -f Tk_MainLoop.3
@@ -525,15 +484,15 @@ if test -r MainLoop.3; then
fi
if test -r MainWin.3; then
rm -f Tk_MainWindow.3
+ rm -f Tk_GetNumMainWindows.3
cp MainWin.3 Tk_MainWindow.3
+ cp MainWin.3 Tk_GetNumMainWindows.3
fi
if test -r MaintGeom.3; then
rm -f Tk_MaintainGeometry.3
+ rm -f Tk_UnmaintainGeometry.3
cp MaintGeom.3 Tk_MaintainGeometry.3
-fi
-if test -r CrtWindow.3; then
- rm -f Tk_MakeWindowExist.3
- cp CrtWindow.3 Tk_MakeWindowExist.3
+ cp MaintGeom.3 Tk_UnmaintainGeometry.3
fi
if test -r ManageGeom.3; then
rm -f Tk_ManageGeometry.3
@@ -541,152 +500,48 @@ if test -r ManageGeom.3; then
fi
if test -r MapWindow.3; then
rm -f Tk_MapWindow.3
+ rm -f Tk_UnmapWindow.3
cp MapWindow.3 Tk_MapWindow.3
+ cp MapWindow.3 Tk_UnmapWindow.3
fi
if test -r MeasureChar.3; then
rm -f Tk_MeasureChars.3
+ rm -f Tk_TextWidth.3
+ rm -f Tk_DrawChars.3
+ rm -f Tk_UnderlineChars.3
cp MeasureChar.3 Tk_MeasureChars.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_MoveResizeWindow.3
- cp ConfigWind.3 Tk_MoveResizeWindow.3
+ cp MeasureChar.3 Tk_TextWidth.3
+ cp MeasureChar.3 Tk_DrawChars.3
+ cp MeasureChar.3 Tk_UnderlineChars.3
fi
if test -r MoveToplev.3; then
rm -f Tk_MoveToplevelWindow.3
cp MoveToplev.3 Tk_MoveToplevelWindow.3
fi
-if test -r ConfigWind.3; then
- rm -f Tk_MoveWindow.3
- cp ConfigWind.3 Tk_MoveWindow.3
-fi
if test -r Name.3; then
rm -f Tk_Name.3
+ rm -f Tk_PathName.3
+ rm -f Tk_NameToWindow.3
cp Name.3 Tk_Name.3
-fi
-if test -r 3DBorder.3; then
- rm -f Tk_NameOf3DBorder.3
- cp 3DBorder.3 Tk_NameOf3DBorder.3
-fi
-if test -r GetAnchor.3; then
- rm -f Tk_NameOfAnchor.3
- cp GetAnchor.3 Tk_NameOfAnchor.3
-fi
-if test -r GetBitmap.3; then
- rm -f Tk_NameOfBitmap.3
- cp GetBitmap.3 Tk_NameOfBitmap.3
-fi
-if test -r GetCapStyl.3; then
- rm -f Tk_NameOfCapStyle.3
- cp GetCapStyl.3 Tk_NameOfCapStyle.3
-fi
-if test -r GetColor.3; then
- rm -f Tk_NameOfColor.3
- cp GetColor.3 Tk_NameOfColor.3
-fi
-if test -r GetCursor.3; then
- rm -f Tk_NameOfCursor.3
- cp GetCursor.3 Tk_NameOfCursor.3
-fi
-if test -r GetFont.3; then
- rm -f Tk_NameOfFont.3
- cp GetFont.3 Tk_NameOfFont.3
+ cp Name.3 Tk_PathName.3
+ cp Name.3 Tk_NameToWindow.3
fi
if test -r NameOfImg.3; then
rm -f Tk_NameOfImage.3
cp NameOfImg.3 Tk_NameOfImage.3
fi
-if test -r GetJoinStl.3; then
- rm -f Tk_NameOfJoinStyle.3
- cp GetJoinStl.3 Tk_NameOfJoinStyle.3
-fi
-if test -r GetJustify.3; then
- rm -f Tk_NameOfJustify.3
- cp GetJustify.3 Tk_NameOfJustify.3
-fi
-if test -r GetRelief.3; then
- rm -f Tk_NameOfRelief.3
- cp GetRelief.3 Tk_NameOfRelief.3
-fi
-if test -r Name.3; then
- rm -f Tk_NameToWindow.3
- cp Name.3 Tk_NameToWindow.3
-fi
-if test -r ConfigWidg.3; then
- rm -f Tk_Offset.3
- cp ConfigWidg.3 Tk_Offset.3
-fi
if test -r OwnSelect.3; then
rm -f Tk_OwnSelection.3
cp OwnSelect.3 Tk_OwnSelection.3
fi
-if test -r WindowId.3; then
- rm -f Tk_Parent.3
- cp WindowId.3 Tk_Parent.3
-fi
if test -r ParseArgv.3; then
rm -f Tk_ParseArgv.3
cp ParseArgv.3 Tk_ParseArgv.3
fi
-if test -r Name.3; then
- rm -f Tk_PathName.3
- cp Name.3 Tk_PathName.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoBlank.3
- cp FindPhoto.3 Tk_PhotoBlank.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoExpand.3
- cp FindPhoto.3 Tk_PhotoExpand.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoGetImage.3
- cp FindPhoto.3 Tk_PhotoGetImage.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoGetSize.3
- cp FindPhoto.3 Tk_PhotoGetSize.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoPutBlock.3
- cp FindPhoto.3 Tk_PhotoPutBlock.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoPutZoomedBlock.3
- cp FindPhoto.3 Tk_PhotoPutZoomedBlock.3
-fi
-if test -r FindPhoto.3; then
- rm -f Tk_PhotoSetSize.3
- cp FindPhoto.3 Tk_PhotoSetSize.3
-fi
-if test -r TextLayout.3; then
- rm -f Tk_PointToChar.3
- cp TextLayout.3 Tk_PointToChar.3
-fi
-if test -r FontId.3; then
- rm -f Tk_PostscriptFontName.3
- cp FontId.3 Tk_PostscriptFontName.3
-fi
if test -r QWinEvent.3; then
rm -f Tk_QueueWindowEvent.3
cp QWinEvent.3 Tk_QueueWindowEvent.3
fi
-if test -r GetImage.3; then
- rm -f Tk_RedrawImage.3
- cp GetImage.3 Tk_RedrawImage.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_ReqHeight.3
- cp WindowId.3 Tk_ReqHeight.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_ReqWidth.3
- cp WindowId.3 Tk_ReqWidth.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_ResizeWindow.3
- cp ConfigWind.3 Tk_ResizeWindow.3
-fi
if test -r Restack.3; then
rm -f Tk_RestackWindow.3
cp Restack.3 Tk_RestackWindow.3
@@ -695,169 +550,153 @@ if test -r RestrictEv.3; then
rm -f Tk_RestrictEvents.3
cp RestrictEv.3 Tk_RestrictEvents.3
fi
-if test -r WindowId.3; then
- rm -f Tk_Screen.3
- cp WindowId.3 Tk_Screen.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_ScreenNumber.3
- cp WindowId.3 Tk_ScreenNumber.3
-fi
if test -r SetAppName.3; then
rm -f Tk_SetAppName.3
cp SetAppName.3 Tk_SetAppName.3
fi
-if test -r 3DBorder.3; then
- rm -f Tk_SetBackgroundFromBorder.3
- cp 3DBorder.3 Tk_SetBackgroundFromBorder.3
-fi
if test -r SetClass.3; then
rm -f Tk_SetClass.3
+ rm -f Tk_Class.3
cp SetClass.3 Tk_SetClass.3
+ cp SetClass.3 Tk_Class.3
fi
if test -r SetGrid.3; then
rm -f Tk_SetGrid.3
+ rm -f Tk_UnsetGrid.3
cp SetGrid.3 Tk_SetGrid.3
+ cp SetGrid.3 Tk_UnsetGrid.3
fi
-if test -r GeomReq.3; then
- rm -f Tk_SetInternalBorder.3
- cp GeomReq.3 Tk_SetInternalBorder.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_SetWindowBackground.3
- cp ConfigWind.3 Tk_SetWindowBackground.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_SetWindowBackgroundPixmap.3
- cp ConfigWind.3 Tk_SetWindowBackgroundPixmap.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_SetWindowBorder.3
- cp ConfigWind.3 Tk_SetWindowBorder.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_SetWindowBorderPixmap.3
- cp ConfigWind.3 Tk_SetWindowBorderPixmap.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_SetWindowBorderWidth.3
- cp ConfigWind.3 Tk_SetWindowBorderWidth.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_SetWindowColormap.3
- cp ConfigWind.3 Tk_SetWindowColormap.3
+if test -r SetOptions.3; then
+ rm -f Tk_CreateOptionTable.3
+ rm -f Tk_DeleteOptionTable.3
+ rm -f Tk_InitOptions.3
+ rm -f Tk_SetOptions.3
+ rm -f Tk_FreeSavedOptions.3
+ rm -f Tk_RestoreSavedOptions.3
+ rm -f Tk_GetOptionValue.3
+ rm -f Tk_GetOptionInfo.3
+ rm -f Tk_FreeConfigOptions.3
+ rm -f Tk_Offset.3
+ cp SetOptions.3 Tk_CreateOptionTable.3
+ cp SetOptions.3 Tk_DeleteOptionTable.3
+ cp SetOptions.3 Tk_InitOptions.3
+ cp SetOptions.3 Tk_SetOptions.3
+ cp SetOptions.3 Tk_FreeSavedOptions.3
+ cp SetOptions.3 Tk_RestoreSavedOptions.3
+ cp SetOptions.3 Tk_GetOptionValue.3
+ cp SetOptions.3 Tk_GetOptionInfo.3
+ cp SetOptions.3 Tk_FreeConfigOptions.3
+ cp SetOptions.3 Tk_Offset.3
fi
if test -r SetVisual.3; then
rm -f Tk_SetWindowVisual.3
cp SetVisual.3 Tk_SetWindowVisual.3
fi
-if test -r GetBitmap.3; then
- rm -f Tk_SizeOfBitmap.3
- cp GetBitmap.3 Tk_SizeOfBitmap.3
-fi
-if test -r GetImage.3; then
- rm -f Tk_SizeOfImage.3
- cp GetImage.3 Tk_SizeOfImage.3
-fi
if test -r StrictMotif.3; then
rm -f Tk_StrictMotif.3
cp StrictMotif.3 Tk_StrictMotif.3
fi
if test -r TextLayout.3; then
- rm -f Tk_TextLayoutToPostscript.3
- cp TextLayout.3 Tk_TextLayoutToPostscript.3
-fi
-if test -r MeasureChar.3; then
- rm -f Tk_TextWidth.3
- cp MeasureChar.3 Tk_TextWidth.3
-fi
-if test -r GetUid.3; then
- rm -f Tk_Uid.3
- cp GetUid.3 Tk_Uid.3
-fi
-if test -r ConfigWind.3; then
- rm -f Tk_UndefineCursor.3
- cp ConfigWind.3 Tk_UndefineCursor.3
-fi
-if test -r MeasureChar.3; then
- rm -f Tk_UnderlineChars.3
- cp MeasureChar.3 Tk_UnderlineChars.3
-fi
-if test -r TextLayout.3; then
+ rm -f Tk_ComputeTextLayout.3
+ rm -f Tk_FreeTextLayout.3
+ rm -f Tk_DrawTextLayout.3
rm -f Tk_UnderlineTextLayout.3
+ rm -f Tk_PointToChar.3
+ rm -f Tk_CharBbox.3
+ rm -f Tk_DistanceToTextLayout.3
+ rm -f Tk_IntersectTextLayout.3
+ rm -f Tk_TextLayoutToPostscript.3
+ cp TextLayout.3 Tk_ComputeTextLayout.3
+ cp TextLayout.3 Tk_FreeTextLayout.3
+ cp TextLayout.3 Tk_DrawTextLayout.3
cp TextLayout.3 Tk_UnderlineTextLayout.3
+ cp TextLayout.3 Tk_PointToChar.3
+ cp TextLayout.3 Tk_CharBbox.3
+ cp TextLayout.3 Tk_DistanceToTextLayout.3
+ cp TextLayout.3 Tk_IntersectTextLayout.3
+ cp TextLayout.3 Tk_TextLayoutToPostscript.3
fi
-if test -r MaintGeom.3; then
- rm -f Tk_UnmaintainGeometry.3
- cp MaintGeom.3 Tk_UnmaintainGeometry.3
-fi
-if test -r MapWindow.3; then
- rm -f Tk_UnmapWindow.3
- cp MapWindow.3 Tk_UnmapWindow.3
-fi
-if test -r SetGrid.3; then
- rm -f Tk_UnsetGrid.3
- cp SetGrid.3 Tk_UnsetGrid.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_Visual.3
- cp WindowId.3 Tk_Visual.3
-fi
-if test -r WindowId.3; then
- rm -f Tk_Width.3
- cp WindowId.3 Tk_Width.3
+if test -r TkInitStubs.3; then
+ rm -f Tk_InitStubs.3
+ cp TkInitStubs.3 Tk_InitStubs.3
fi
if test -r WindowId.3; then
rm -f Tk_WindowId.3
- cp WindowId.3 Tk_WindowId.3
-fi
-if test -r WindowId.3; then
+ rm -f Tk_Parent.3
+ rm -f Tk_Display.3
+ rm -f Tk_DisplayName.3
+ rm -f Tk_ScreenNumber.3
+ rm -f Tk_Screen.3
rm -f Tk_X.3
- cp WindowId.3 Tk_X.3
-fi
-if test -r WindowId.3; then
rm -f Tk_Y.3
+ rm -f Tk_Width.3
+ rm -f Tk_Height.3
+ rm -f Tk_Changes.3
+ rm -f Tk_Attributes.3
+ rm -f Tk_IsContainer.3
+ rm -f Tk_IsEmbedded.3
+ rm -f Tk_IsMapped.3
+ rm -f Tk_IsTopLevel.3
+ rm -f Tk_ReqWidth.3
+ rm -f Tk_ReqHeight.3
+ rm -f Tk_InternalBorderWidth.3
+ rm -f Tk_Visual.3
+ rm -f Tk_Depth.3
+ rm -f Tk_Colormap.3
+ cp WindowId.3 Tk_WindowId.3
+ cp WindowId.3 Tk_Parent.3
+ cp WindowId.3 Tk_Display.3
+ cp WindowId.3 Tk_DisplayName.3
+ cp WindowId.3 Tk_ScreenNumber.3
+ cp WindowId.3 Tk_Screen.3
+ cp WindowId.3 Tk_X.3
cp WindowId.3 Tk_Y.3
-fi
-if test -r menubar.n; then
- rm -f tk_bindForTraversal.n
- cp menubar.n tk_bindForTraversal.n
-fi
-if test -r palette.n; then
- rm -f tk_bisque.n
- cp palette.n tk_bisque.n
+ cp WindowId.3 Tk_Width.3
+ cp WindowId.3 Tk_Height.3
+ cp WindowId.3 Tk_Changes.3
+ cp WindowId.3 Tk_Attributes.3
+ cp WindowId.3 Tk_IsContainer.3
+ cp WindowId.3 Tk_IsEmbedded.3
+ cp WindowId.3 Tk_IsMapped.3
+ cp WindowId.3 Tk_IsTopLevel.3
+ cp WindowId.3 Tk_ReqWidth.3
+ cp WindowId.3 Tk_ReqHeight.3
+ cp WindowId.3 Tk_InternalBorderWidth.3
+ cp WindowId.3 Tk_Visual.3
+ cp WindowId.3 Tk_Depth.3
+ cp WindowId.3 Tk_Colormap.3
fi
if test -r chooseColor.n; then
rm -f tk_chooseColor.n
cp chooseColor.n tk_chooseColor.n
fi
+if test -r chooseDirectory.n; then
+ rm -f tk_chooseDirectory.n
+ cp chooseDirectory.n tk_chooseDirectory.n
+fi
if test -r dialog.n; then
rm -f tk_dialog.n
cp dialog.n tk_dialog.n
fi
if test -r focusNext.n; then
- rm -f tk_focusFollowsMouse.n
- cp focusNext.n tk_focusFollowsMouse.n
-fi
-if test -r focusNext.n; then
rm -f tk_focusNext.n
- cp focusNext.n tk_focusNext.n
-fi
-if test -r focusNext.n; then
rm -f tk_focusPrev.n
+ rm -f tk_focusFollowsMouse.n
+ cp focusNext.n tk_focusNext.n
cp focusNext.n tk_focusPrev.n
+ cp focusNext.n tk_focusFollowsMouse.n
fi
if test -r getOpenFile.n; then
rm -f tk_getOpenFile.n
- cp getOpenFile.n tk_getOpenFile.n
-fi
-if test -r getOpenFile.n; then
rm -f tk_getSaveFile.n
+ cp getOpenFile.n tk_getOpenFile.n
cp getOpenFile.n tk_getSaveFile.n
fi
if test -r menubar.n; then
rm -f tk_menuBar.n
+ rm -f tk_bindForTraversal.n
cp menubar.n tk_menuBar.n
+ cp menubar.n tk_bindForTraversal.n
fi
if test -r messageBox.n; then
rm -f tk_messageBox.n
@@ -867,12 +706,14 @@ if test -r optionMenu.n; then
rm -f tk_optionMenu.n
cp optionMenu.n tk_optionMenu.n
fi
-if test -r popup.n; then
- rm -f tk_popup.n
- cp popup.n tk_popup.n
-fi
if test -r palette.n; then
rm -f tk_setPalette.n
+ rm -f tk_bisque.n
cp palette.n tk_setPalette.n
+ cp palette.n tk_bisque.n
+fi
+if test -r popup.n; then
+ rm -f tk_popup.n
+ cp popup.n tk_popup.n
fi
exit 0
diff --git a/tk/unix/porting.old b/tk/unix/porting.old
new file mode 100644
index 00000000000..ea8aa5c2cc0
--- /dev/null
+++ b/tk/unix/porting.old
@@ -0,0 +1,324 @@
+This is an old version of the file "porting.notes". It contains
+porting information that people submitted for Tk releases numbered
+3.6 and earlier. You may find information in this file useful if
+there is no information available for your machine in the current
+version of "porting.notes".
+
+I don't have personal access to any of these machines, so I make
+no guarantees that the notes are correct, complete, or up-to-date.
+If you see the word "I" in any explanations, it refers to the person
+who contributed the information, not to me; this means that I
+probably can't answer any questions about any of this stuff. In
+some cases, a person has volunteered to act as a contact point for
+questions about porting Tcl to a particular machine; in these
+cases the person's name and e-mail address are listed. I'd be
+happy to receive corrections or updates.
+
+sccsid = SCCS: @(#) porting.old 1.2 96/02/16 10:27:30
+
+---------------------------------------------
+DEC Alphas:
+---------------------------------------------
+
+1. There appears to be a compiler/library bug that prevents tkTrig.c
+from compiling unless you turn off optimization (remove the -O compiler
+switch). The problem appears to have been fixed in the 1.3-4 version
+of the compiler.
+
+---------------------------------------------
+HP-UX systems:
+---------------------------------------------
+
+1. Configuration:
+ HP-UX Release 7.05 on a series 300 (68k) machine.
+ The native cc has been used for production.
+ X11r4 libraries and include files were taken from
+ internet archives, where as the server came with HPUX release 7.05.
+
+ Problems:
+ Symbol table space for cc had to be increased with: -Wc,-Ns3000
+ tkBind.c did not compile under -O:
+ C1 internal error in "GetField": Set Error Detected
+ *** Error code 1
+ tkBind.c did compile without optimization (no -O).
+
+2. Note: if you have trouble getting xauth-style access control to work
+(and you'll need xauth if you want to use "send"), be sure to uncomment
+the line
+
+# Vuelogin*authorize: True
+
+in the file /usr/vue/config/Xconfig, so that the server starts up with
+authorization enabled. Also, you may have to reboot the machine in
+order to force the server to restart.
+
+---------------------------------------------
+SCO Unix:
+---------------------------------------------
+
+Getting Tk to run under SCO Unix:
+
+Add a "#undef select" to tkEvent.c, and remove the reference to TK_EXCEPTION
+around line 460 of main.c.
+
+Tk uses its own scheme for allocating the border colors for its 3D widgets,
+which causes problems when running TK on a system with "PseudoColor"
+display class, and a 16-cell colormap.
+
+If you can't go to eight bitplanes, you can instead start the server with a
+"-static" (Xsco) or "-analog" (Xsight) option, making the display class
+become "StaticColor". This makes the entire colormap read-only, and it will
+return the color that most closely maps to the desired color as possible.
+
+---------------------------------------------
+Silicon Graphics systems:
+---------------------------------------------
+
+1. Change the CC variable in the Makefile to:
+
+CC = cc -xansi -D__STDC__ -signed
+
+2. Change the LIBS variable in the Makefile to use the X11 shared library
+ ("-lX11_s" instead of "-lX11").
+
+3. Under some versions of IRIX (e.g. 4.0.1) you have to turn off
+ optimization (e.g. change "-O" in CFLAGS to "-O0" or remove it
+ entirely) because of faulty code generation. If the Tcl or Tk test
+ suites fail, turn off optimization.
+
+4. Add a "-lsun" switch just before "-lm" in the LIBS definition.
+ Under some versions of IRIX (5.1.1.3?) you'll need to omit the
+ "-lsun" switch, plus remove the "-lsocket" and "-lnsl" switches
+ added by the configure script; otherwise you won't be able to
+ use symbolic host names for the display, only numerical Internet
+ addresses.
+
+5. Rumor has it that you'll also need a "-lmalloc" switch in the
+ LIBS definition.
+
+6. In IRIX 5.2 you'll have to modify Makefile to fix the following problems:
+ - The "-c" option is illegal with this version of install, but
+ the "-F" switch is needed instead. Change this in the "INSTALL ="
+ definition line.
+ - The order of file and directory have to be changed in all the
+ invocations of INSTALL_DATA or INSTALL_PROGRAM.
+
+---------------------------------------------
+IBM RS/6000's:
+---------------------------------------------
+1. To allow ALT- sequences to work on the RS-6000, the following
+line should be changed in tkBind.c:
+
+ OLD LINE:
+ {"Alt", Mod2Mask, 0},
+ NEW LINE:
+ {"Alt", Mod1Mask, 0},
+
+---------------------------------------------
+AT&T SVR4:
+---------------------------------------------
+
+1. The first major hurdle is that SVR4's select() subtly differs
+from BSD select. This impacts Tk in two ways, some of the Xlib calls
+make use of select() and are inherently broken and Tk itself makes
+extensive use of select(). The first problem can't be fixed without
+rebuilding one's Xlib, but can be avoided. I intend to submit part
+of my work the XFree86 guys so that the next version of XFree86 for
+SVR4 will not be broken. Until then, it is necessary to comment out
+this section of code from Tk_DoOneEvent() (which is near line 1227):
+
+#if !defined(SVR4)
+ void (*oldHandler)();
+
+ oldHandler = (void (*)()) signal(SIGPIPE, SIG_IGN);
+ XNoOp(display);
+ XFlush(display);
+ (void) signal(SIGPIPE, oldHandler);
+#endif /* SVR4 */
+
+if you don't comment it out, some scripts cause wish to go into
+an infinite loop of sending no-ops to the X server.
+
+2. As for fixing Tk's calls to select(), I've taken the simple
+approach of writing a wrapper for select and then using #define to
+replace all calls to select with the wrapper. I chose tkConfig.h
+to load the wrapper. So at the very end of tkConfig.h, it now looks
+like:
+
+#if defined(SVR4)
+# include "BSDselect.h"
+#endif
+
+#endif /* _TKCONFIG */
+
+The file BSDselect.h looks like this:
+
+#include <sys/types.h>
+#include <sys/time.h>
+#include <sys/select.h>
+
+/* This is a fix for the difference between BSD's select() and
+ * SVR4's select(). SVR4's select() can never return a value larger
+ * than the total number of file descriptors being checked. So, if
+ * you select for read and write on one file descriptor, and both
+ * are true, SVR4 select() will only return 1. BSD select in the
+ * same situation will return 2.
+ *
+ * Additionally, BSD select() on timing out, will zero the masks,
+ * while SVR4 does not. This is fixed here as well.
+ *
+ * Set your tabstops to 4 characters to have this code nicely formatted.
+ *
+ * Jerry Whelan, guru@bradley.edu, June 12th, 1993
+ */
+
+
+int
+BSDselect(nfds, readfds, writefds, exceptfds, timeout)
+int nfds;
+fd_set *readfds, *writefds, *exceptfds;
+struct timeval *timeout;
+{
+ int rval,
+ i;
+
+ rval = select(nfds, readfds, writefds, exceptfds, timeout);
+
+ switch(rval) {
+ case -1: return(rval);
+ break;
+
+ case 0: if(readfds != NULL)
+ FD_ZERO(readfds);
+ if(writefds != NULL)
+ FD_ZERO(writefds);
+ if(exceptfds != NULL)
+ FD_ZERO(exceptfds);
+
+ return(rval);
+ break;
+
+ default: for(i=0, rval=0; i < nfds; i++) {
+ if((readfds != NULL) && FD_ISSET
+(i, readfds)) rval++;
+ if((writefds != NULL) && FD_ISSE
+T(i, writefds)) rval++;
+ if((writefds != NULL) && FD_ISSE
+T(i, exceptfds)) rval++;
+ }
+ return(rval);
+ }
+/* Should never get here */
+}
+
+---------------------------------------------
+CDC 4680MP, EP/IX 1.4.3:
+---------------------------------------------
+
+The installation was done in the System V environment (-systype sysv)
+with the BSD extensions available (-I/usr/include/bsd and -lbsd). It was
+built with the 2.20 level C compiler. The 2.11 level can be used, but
+it is better to match what TCL is built with, which must be 2.20 or
+higher (see the porting notes with TCL for the details).
+
+To make the configure script find the BSD extensions, I set environment
+variable DEFS to "-I/usr/include/bsd" and LIBS to "-lbsd" before
+running it. I would have also set CC to "cc2.20", but that compiler
+driver has a bug that loader errors (e.g. not finding a library routine,
+which the script uses to tell what is available) do not cause an error
+status to be returned to the shell (but see the Tcl 2.1.1 porting notes
+for comments about using "-non_shared").
+
+After running configure, I changed the CC definition line in Makefile
+from:
+ CC=cc
+to
+ CC=cc2.20
+to match the TCL build. Skip this if the default compiler is already 2.20
+(or later).
+
+---------------------------------------------
+CDC 4680MP, EP/IX 2.1.1:
+---------------------------------------------
+
+The installation was done in the System V environment (-systype sysv)
+with the BSD extensions available (-I/usr/include/bsd and -lbsd). It was
+built with the 3.11 level C compiler. Earlier levels can be used, but it
+is better to match what TCL is built with, which must be 2.20 or higher
+(see the porting notes with TCL for the details).
+
+To make the configure script find the BSD extensions, I set environment
+variable DEFS to "-I/usr/include/bsd -non_shared" and LIBS to "-lbsd"
+before running it.
+
+See the Tcl porting notes for comments on why "-non_shared" is needed
+during the configuration step. It was removed from AC_FLAGS before
+building.
+
+-------------------------------------------------
+Pyramid, OSx 5.1a (UCB universe, GCC installed):
+-------------------------------------------------
+
+Instead of typing "./configure" to configure, type
+
+ DEFS="-I/usr/include/X11/attinc" ./configure
+
+to sh to do the configuration.
+
+-------------------------------------------------
+NextSTEP 3.1:
+-------------------------------------------------
+
+1. Run configure with predefined CPP:
+ CPP='cc -E' ./configure
+ (If your shell is [t]csh, do a "setenv CPP 'cc -E'")
+
+2. Edit Makefile:
+ -add the following to AC_FLAGS:
+ -Dstrtod=tcl_strtod
+
+Note: Tk's raise test may fail when running the tvtwm window manager.
+Changing to either twm or even better fvwm ensures that this test will
+succeed.
+
+-------------------------------------------------
+Encore 91, UMAX V 3.0.9.3:
+-------------------------------------------------
+
+1. Modify the CFLAGS definition in Makefile to include -DENCORE:
+
+ CFLAGS = -O -DENCORE
+
+2. "mkdir" does not by default create the parent directories. The mkdir
+directives should be modified to "midir -p".
+
+3. An error of a redeclaration of read, can be resolved by conditionally
+not compiling if an ENCORE system.
+
+#ifndef ENCORE
+extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
+#endif
+
+-------------------------------------------------
+Sequent machines running Dynix:
+Contact: Andrew Swan (aswan@soda.berkeley.edu)
+-------------------------------------------------
+
+1. Use gcc instead of the cc distributed by Sequent
+
+2. There are problems with the distributed version of
+ <stddef.h>. The easiest solution is probably to create a
+ copy of stddef.h, make sure it comes early in the include
+ path and then edit it as need be to eliminate conflicts
+ with the X11 header files.
+
+3. The same comments about the tanh function from the notes on
+ porting Tcl apply to Tk.
+
+-------------------------------------------------
+Systems running Interactive 4.0:
+-------------------------------------------------
+
+1. Add "-posix" to CFLAGS in Makefile (or Makefile.in).
+
+2. Add "-lnsl_s" to LIBS in Makefile (or Makefile.in).
diff --git a/tk/unix/tcl.m4 b/tk/unix/tcl.m4
new file mode 100644
index 00000000000..6ebd6a4b805
--- /dev/null
+++ b/tk/unix/tcl.m4
@@ -0,0 +1,1882 @@
+#------------------------------------------------------------------------
+# SC_PATH_TCLCONFIG --
+#
+# Locate the tclConfig.sh file and perform a sanity check on
+# the Tcl compile flags
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tcl=...
+#
+# Defines the following vars:
+# TCL_BIN_DIR Full path to the directory containing
+# the tclConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TCLCONFIG, [
+ #
+ # Ok, lets find the tcl configuration
+ # First, look for one uninstalled.
+ # the alternative search directory is invoked by --with-tcl
+ #
+
+ if test x"${no_tcl}" = x ; then
+ # we reset no_tcl in case something fails here
+ no_tcl=true
+ AC_ARG_WITH(tcl, [ --with-tcl directory containing tcl configuration (tclConfig.sh)], with_tclconfig=${withval})
+ AC_MSG_CHECKING([for Tcl configuration])
+ AC_CACHE_VAL(ac_cv_c_tclconfig,[
+
+ # First check to see if --with-tclconfig was specified.
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh])
+ fi
+ fi
+
+ # then check for a private Tcl installation
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ../tcl \
+ `ls -dr ../tcl[[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
+ if test -f "$i/win/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+
+ # check in a few common install locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+
+ # check in a few other private locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tcl \
+ `ls -dr ${srcdir}/../tcl[[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
+ if test -f "$i/win/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+ ])
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCL_BIN_DIR="# no Tcl configs found"
+ AC_MSG_ERROR(Can't find Tcl configuration definitions)
+ exit 0
+ else
+ no_tcl=
+ TCL_BIN_DIR=${ac_cv_c_tclconfig}
+ AC_MSG_RESULT(found $TCL_BIN_DIR/tclConfig.sh)
+ fi
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_PATH_TKCONFIG --
+#
+# Locate the tkConfig.sh file
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tk=...
+#
+# Defines the following vars:
+# TK_BIN_DIR Full path to the directory containing
+# the tkConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TKCONFIG, [
+ #
+ # Ok, lets find the tk configuration
+ # First, look for one uninstalled.
+ # the alternative search directory is invoked by --with-tk
+ #
+
+ if test x"${no_tk}" = x ; then
+ # we reset no_tk in case something fails here
+ no_tk=true
+ AC_ARG_WITH(tk, [ --with-tk directory containing tk configuration (tkConfig.sh)], with_tkconfig=${withval})
+ AC_MSG_CHECKING([for Tk configuration])
+ AC_CACHE_VAL(ac_cv_c_tkconfig,[
+
+ # First check to see if --with-tkconfig was specified.
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh])
+ fi
+ fi
+
+ # then check for a private Tk library
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in \
+ ../tk \
+ `ls -dr ../tk[[8-9]].[[0-9]]* 2>/dev/null` \
+ ../../tk \
+ `ls -dr ../../tk[[8-9]].[[0-9]]* 2>/dev/null` \
+ ../../../tk \
+ `ls -dr ../../../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ if test -f "$i/win/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few common install locations
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib 2>/dev/null` \
+ `ls -d /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few other private locations
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tk \
+ `ls -dr ${srcdir}/../tk[[8-9]].[[0-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ if test -f "$i/win/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/win; pwd)`
+ break
+ fi
+ done
+ fi
+ ])
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TK_BIN_DIR="# no Tk configs found"
+ AC_MSG_ERROR(Can't find Tk configuration definitions)
+ exit 0
+ else
+ no_tk=
+ TK_BIN_DIR=${ac_cv_c_tkconfig}
+ AC_MSG_RESULT(found $TK_BIN_DIR/tkConfig.sh)
+ fi
+ fi
+
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TCLCONFIG --
+#
+# Load the tclConfig.sh file
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TCL_BIN_DIR
+#
+# Results:
+#
+# Subst the following vars:
+# TCL_BIN_DIR
+# TCL_SRC_DIR
+# TCL_LIB_FILE
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TCLCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh])
+
+ if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then
+ AC_MSG_RESULT([loading])
+ . $TCL_BIN_DIR/tclConfig.sh
+ else
+ AC_MSG_RESULT([file not found])
+ fi
+
+ #
+ # The eval is required to do the TCL_DBGX substitution in the
+ # TCL_LIB_FILE variable
+ #
+
+ eval TCL_LIB_FILE=${TCL_LIB_FILE}
+ eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+
+ AC_SUBST(TCL_BIN_DIR)
+ AC_SUBST(TCL_SRC_DIR)
+ AC_SUBST(TCL_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TKCONFIG --
+#
+# Load the tkConfig.sh file
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TK_BIN_DIR
+#
+# Results:
+#
+# Sets the following vars that should be in tkConfig.sh:
+# TK_BIN_DIR
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TKCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCLCONFIG])
+
+ if test -f "$TK_BIN_DIR/tkConfig.sh" ; then
+ AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh])
+ . $TK_BIN_DIR/tkConfig.sh
+ else
+ AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
+ fi
+
+ AC_SUBST(TK_BIN_DIR)
+ AC_SUBST(TK_SRC_DIR)
+ AC_SUBST(TK_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SHARED --
+#
+# Allows the building of shared libraries
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-shared=yes|no
+#
+# Defines the following vars:
+# STATIC_BUILD Used for building import/export libraries
+# on Windows.
+#
+# Sets the following vars:
+# SHARED_BUILD Value of 1 or 0
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SHARED, [
+ AC_MSG_CHECKING([how to build libraries])
+ AC_ARG_ENABLE(shared,
+ [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=no
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ AC_MSG_RESULT([shared])
+ SHARED_BUILD=1
+ else
+ AC_MSG_RESULT([static])
+ SHARED_BUILD=0
+ AC_DEFINE(STATIC_BUILD)
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_THREADS --
+#
+# Specify if thread support should be enabled
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-threads
+#
+# Sets the following vars:
+# THREADS_LIBS Thread library(s)
+#
+# Defines the following vars:
+# TCL_THREADS
+# _REENTRANT
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_THREADS, [
+ AC_MSG_CHECKING(for building with threads)
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "$tcl_ok" = "yes"; then
+ AC_MSG_RESULT(yes)
+ TCL_THREADS=1
+ AC_DEFINE(TCL_THREADS)
+ AC_DEFINE(_REENTRANT)
+ AC_DEFINE(_THREAD_SAFE)
+ AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "no"; then
+ # Check a little harder for __pthread_mutex_init in the same
+ # library, as some systems hide it there until pthread.h is
+ # defined. We could alternatively do an AC_TRY_COMPILE with
+ # pthread.h, but that will work with libpthread really doesn't
+ # exist, like AIX 4.2. [Bug: 4359]
+ AC_CHECK_LIB(pthread,__pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthread"
+ else
+ AC_CHECK_LIB(pthreads,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthreads"
+ else
+ AC_CHECK_LIB(c,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "no"; then
+ TCL_THREADS=0
+ AC_MSG_WARN("Don t know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...")
+ fi
+ fi
+ fi
+
+ # Does the pthread-implementation provide
+ # 'pthread_attr_setstacksize' ?
+
+ AC_CHECK_FUNCS(pthread_attr_setstacksize)
+ else
+ TCL_THREADS=0
+ AC_MSG_RESULT(no (default))
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SYMBOLS --
+#
+# Specify if debugging symbols should be used
+#
+# Arguments:
+# none
+#
+# Requires the following vars to be set in the Makefile:
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+# LDFLAGS_DEBUG
+# LDFLAGS_OPTIMIZE
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-symbols
+#
+# Defines the following vars:
+# CFLAGS_DEFAULT Sets to $(CFLAGS_DEBUG) if true
+# Sets to $(CFLAGS_OPTIMIZE) if false
+# LDFLAGS_DEFAULT Sets to $(LDFLAGS_DEBUG) if true
+# Sets to $(LDFLAGS_OPTIMIZE) if false
+# DBGX Debug library extension
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SYMBOLS, [
+ AC_MSG_CHECKING([for build with symbols])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=g
+ AC_MSG_RESULT([yes])
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ AC_MSG_RESULT([no])
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_CONFIG_CFLAGS
+#
+# Try to determine the proper flags to pass to the compiler
+# for building shared libraries and other such nonsense.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines the following vars:
+#
+# DL_OBJS - Name of the object file that implements dynamic
+# loading for Tcl on this system.
+# DL_LIBS - Library file(s) to include in tclsh and other base
+# applications in order for the "load" command to work.
+# LDFLAGS - Flags to pass to the compiler when linking object
+# files into an executable application binary such
+# as tclsh.
+# LD_SEARCH_FLAGS-Flags to pass to ld, such as "-R /usr/local/tcl/lib",
+# that tell the run-time dynamic linker where to look
+# for shared libraries such as libtcl.so. Depends on
+# the variable LIB_RUNTIME_DIR in the Makefile.
+# MAKE_LIB - Command to execute to build the Tcl library;
+# differs depending on whether or not Tcl is being
+# compiled as a shared library.
+# STLIB_LD - Base command to use for combining object files
+# into a static library.
+# SHLIB_CFLAGS - Flags to pass to cc when compiling the components
+# of a shared library (may request position-independent
+# code, among other things).
+# SHLIB_LD - Base command to use for combining object files
+# into a shared library.
+# SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
+# creating shared libraries. This symbol typically
+# goes at the end of the "ld" commands that build
+# shared libraries. The value of the symbol is
+# "${LIBS}" if all of the dependent libraries should
+# be specified when creating a shared library. If
+# dependent libraries should not be specified (as on
+# SunOS 4.x, where they cause the link to fail, or in
+# general if Tcl and Tk aren't themselves shared
+# libraries), then this symbol has an empty string
+# as its value.
+# SHLIB_SUFFIX - Suffix to use for the names of dynamically loadable
+# extensions. An empty string means we don't know how
+# to use shared libraries on this platform.
+# TCL_LIB_FILE - Name of the file that contains the Tcl library, such
+# as libtcl7.8.so or libtcl7.8.a.
+# TCL_LIB_SUFFIX -Specifies everything that comes after the "libtcl"
+# in the shared library name, using the $VERSION variable
+# to put the version in the right place. This is used
+# by platforms that need non-standard library names.
+# Examples: ${VERSION}.so.1.1 on NetBSD, since it needs
+# to have a version after the .so, and ${VERSION}.a
+# on AIX, since the Tcl shared library needs to have
+# a .a extension whereas shared objects for loadable
+# extensions have a .so extension. Defaults to
+# ${VERSION}${SHLIB_SUFFIX}.
+# TCL_NEEDS_EXP_FILE -
+# 1 means that an export file is needed to link to a
+# shared library.
+# TCL_EXP_FILE - The name of the installed export / import file which
+# should be used to link to the Tcl shared library.
+# Empty if Tcl is unshared.
+# TCL_BUILD_EXP_FILE -
+# The name of the built export / import file which
+# should be used to link to the Tcl shared library.
+# Empty if Tcl is unshared.
+# CFLAGS_DEBUG -
+# Flags used when running the compiler in debug mode
+# CFLAGS_OPTIMIZE -
+# Flags used when running the compiler in optimize mode
+#
+# EXTRA_CFLAGS
+#
+# Subst's the following vars:
+# DL_LIBS
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_CONFIG_CFLAGS, [
+
+ # Step 0.a: Enable 64 bit support?
+
+ AC_MSG_CHECKING([if 64bit support is requested])
+ AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)],,enableval="no")
+
+ if test "$enableval" = "yes"; then
+ do64bit=yes
+ else
+ do64bit=no
+ fi
+ AC_MSG_RESULT($do64bit)
+
+ # Step 0.b: Enable Solaris 64 bit VIS support?
+
+ AC_MSG_CHECKING([if 64bit Sparc VIS support is requested])
+ AC_ARG_ENABLE(64bit-vis,[ --enable-64bit-vis enable 64bit Sparc VIS support],,enableval="no")
+
+ if test "$enableval" = "yes"; then
+ # Force 64bit on with VIS
+ do64bit=yes
+ do64bitVIS=yes
+ else
+ do64bitVIS=no
+ fi
+ AC_MSG_RESULT($do64bitVIS)
+
+ # Step 1: set the variable "system" to hold the name and version number
+ # for the system. This can usually be done via the "uname" command, but
+ # there are a few systems, like Next, where this doesn't work.
+
+ AC_MSG_CHECKING([system version (for dynamic loading)])
+ 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
+ AC_MSG_RESULT([unknown (can't find uname command)])
+ system=unknown
+ 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 $3}' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ AC_MSG_RESULT($system)
+ fi
+ fi
+
+ AC_MSG_CHECKING([if gcc is being used])
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ using_gcc="yes"
+ else
+ using_gcc="no"
+ fi
+
+ AC_MSG_RESULT([$using_gcc ($CC)])
+
+ # Step 2: check for existence of -ldl library. This is needed because
+ # Linux can use either -ldl or -ldld for dynamic loading.
+
+ AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
+
+ # Step 3: set configuration options based on system name and version.
+
+ do64bit_ok=no
+ fullSrcDir=`cd $srcdir; pwd`
+ EXTRA_CFLAGS=""
+ TCL_EXPORT_FILE_SUFFIX=""
+ UNSHARED_LIB_SUFFIX=""
+ TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
+ ECHO_VERSION='`echo ${VERSION}`'
+ TCL_LIB_VERSIONS_OK=ok
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ if test "$using_gcc" = "yes" ; then
+ CFLAGS_WARNING="-Wall -Wconversion -Wno-implicit-int"
+ else
+ CFLAGS_WARNING=""
+ fi
+ TCL_NEEDS_EXP_FILE=0
+ TCL_BUILD_EXP_FILE=""
+ TCL_EXP_FILE=""
+dnl FIXME: Replace AC_CHECK_PROG with AC_CHECK_TOOL once cross compiling is fixed.
+dnl AC_CHECK_TOOL(AR, ar, :)
+ AC_CHECK_PROG(AR, ar, ar)
+ STLIB_LD='${AR} cr'
+ case $system in
+ AIX-4.[[2-9]])
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ AC_MSG_RESULT(Using $CC for compiling with threads)
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ AIX-*)
+ if test "${TCL_THREADS}" = "1" -a "$using_gcc" = "no" ; then
+ # AIX requires the _r compiler when gcc isn't being used
+ if test "${CC}" != "cc_r" ; then
+ CC=${CC}_r
+ fi
+ AC_MSG_RESULT(Using $CC for compiling with threads)
+ fi
+ SHLIB_CFLAGS=""
+ SHLIB_LD="$fullSrcDir/ldAix /bin/ld -bhalt:4 -bM:SRE -bE:lib.exp -H512 -T512 -bnoentry"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ LIBOBJS="$LIBOBJS tclLoadAix.o"
+ DL_LIBS="-lld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ TCL_NEEDS_EXP_FILE=1
+ TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.exp'
+ ;;
+ BSD/OS-2.1*|BSD/OS-3*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="shlicc -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ BSD/OS-4.*)
+ SHLIB_CFLAGS="-export-dynamic -fPIC"
+ SHLIB_LD="cc -shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ dgux*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*|HP-UX-*.11.*)
+ SHLIB_SUFFIX=".sl"
+ AC_CHECK_LIB(dld, shl_load, tcl_ok=yes, tcl_ok=no)
+ if test "$tcl_ok" = yes; then
+ SHLIB_CFLAGS="+z"
+ SHLIB_LD="ld -b"
+ SHLIB_LD_LIBS=""
+ DL_OBJS="tclLoadShl.o"
+ DL_LIBS="-ldld"
+ LDFLAGS="-Wl,-E"
+ LD_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
+ fi
+ ;;
+ IRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ ;;
+ IRIX-5.*|IRIX-6.*|IRIX64-6.5*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "yes" ; then
+ EXTRA_CFLAGS="-mabi=n32"
+ LDFLAGS="-mabi=n32"
+ else
+ case $system in
+ IRIX-6.3)
+ # Use to build 6.2 compatible binaries on 6.3.
+ EXTRA_CFLAGS="-n32 -D_OLD_TERMIOS"
+ ;;
+ *)
+ EXTRA_CFLAGS="-n32"
+ ;;
+ esac
+ LDFLAGS="-n32"
+ fi
+ ;;
+ IRIX64-6.*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="ld -32 -shared -rdata_shared"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ ;;
+ Linux*)
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+
+ # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
+ # when you inline the string and math operations. Turn this off to
+ # get rid of the warnings.
+
+ CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
+
+ if test "$have_dl" = yes; then
+ SHLIB_LD="${CC} -shared"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-rdynamic"
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ else
+ AC_CHECK_HEADER(dld.h, [
+ SHLIB_LD="ld -shared"
+ DL_OBJS="tclLoadDld.o"
+ DL_LIBS="-ldld"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""])
+ fi
+ if test "`uname -m`" = "alpha" ; then
+ EXTRA_CFLAGS="-mieee"
+ fi
+ ;;
+ MP-RAS-02*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ MP-RAS-*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS="-Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NetBSD-*|FreeBSD-[[1-2]].*|OpenBSD-*)
+ # Not available on all versions: check for include file.
+ AC_CHECK_HEADER(dlfcn.h, [
+ # NetBSD/SPARC needs -fPIC, -fpic will not do.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ AC_MSG_CHECKING(for ELF)
+ AC_EGREP_CPP(yes, [
+#ifdef __ELF__
+ yes
+#endif
+ ],
+ AC_MSG_RESULT(yes)
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so',
+ AC_MSG_RESULT(no)
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+ )
+ ], [
+ SHLIB_CFLAGS=""
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ ])
+
+ # FreeBSD doesn't handle version numbers with dots.
+
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ FreeBSD-*)
+ # FreeBSD 3.* and greater have ELF.
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -Bshareable -x"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-export-dynamic"
+ LD_SEARCH_FLAGS=""
+ ;;
+ NEXTSTEP-*)
+ SHLIB_CFLAGS=""
+ SHLIB_LD="cc -nostdlib -r"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadNext.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OS/390-*)
+ CFLAGS_OPTIMIZE="" # Optimizer is buggy
+ AC_DEFINE(_OE_SOCKETS) # needed in sys/socket.h
+ ;;
+ OSF1-1.0|OSF1-1.1|OSF1-1.2)
+ # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
+ SHLIB_CFLAGS=""
+ # Hack: make package name same as library name
+ SHLIB_LD='ld -R -export $@:'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadOSF.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-1.*)
+ # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
+ SHLIB_CFLAGS="-fPIC"
+ SHLIB_LD="ld -shared"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ OSF1-V*)
+ # Digital OSF/1
+ SHLIB_CFLAGS=""
+ SHLIB_LD='ld -shared -expect_unresolved "*"'
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ # see pthread_intro(3) for pthread support on osf1, k.furukawa
+ if test "${TCL_THREADS}" = "1" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="${EXTRA_CFLAGS} -pthread"
+ LDFLAGS="-pthread"
+ else
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ fi
+ fi
+
+ ;;
+ RISCos-*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".a"
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ ;;
+ SCO_SV-3.2*)
+ # Note, dlopen is available only on SCO 3.2.5 and greater. However,
+ # this test works, since "uname -s" was non-standard in 3.2.4 and
+ # below.
+ if test "$using_gcc" = "yes" ; then
+ SHLIB_CFLAGS="-fPIC -melf"
+ LDFLAGS="-melf -Wl,-Bexport"
+ else
+ SHLIB_CFLAGS="-Kpic -belf"
+ LDFLAGS="-belf -Wl,-Bexport"
+ fi
+ SHLIB_LD="ld -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS=""
+ LDFLAGS="-belf -Wl,-Bexport"
+ LD_SEARCH_FLAGS=""
+ ;;
+ SINIX*5.4*)
+ SHLIB_CFLAGS="-K PIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ ;;
+ SunOS-4*)
+ SHLIB_CFLAGS="-PIC"
+ SHLIB_LD="ld"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+
+ # SunOS can't handle version numbers with dots in them in library
+ # specs, like -ltcl7.5, so use -ltcl75 instead. Also, it
+ # requires an extra version number at the end of .so file names.
+ # So, the library has to have a name like libtcl75.so.1.0
+
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.so.1.0'
+ UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}\$\{DBGX\}.a'
+ TCL_LIB_VERSIONS_OK=nodots
+ ;;
+ SunOS-5.[[0-6]]*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ LDFLAGS=""
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ ;;
+ SunOS-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="/usr/ccs/bin/ld -G -z text"
+ LDFLAGS=""
+
+ do64bit_ok=no
+ if test "$do64bit" = "yes" ; then
+ arch=`isainfo`
+ if test "$arch" = "sparcv9 sparc" ; then
+ if test "$using_gcc" = "no" ; then
+ do64bit_ok=yes
+ if test "$do64bitVIS" = "yes" ; then
+ EXTRA_CFLAGS="-xarch=v9a"
+ LDFLAGS="-xarch=v9a"
+ else
+ EXTRA_CFLAGS="-xarch=v9"
+ LDFLAGS="-xarch=v9"
+ fi
+ else
+ AC_MSG_WARN("64bit mode not supported with GCC on $system")
+ fi
+ else
+ AC_MSG_WARN("64bit mode only supported sparcv9 system")
+ fi
+ fi
+
+ # Note: need the LIBS below, otherwise Tk won't find Tcl's
+ # symbols when dynamically loaded into tclsh.
+
+ SHLIB_LD_LIBS='${LIBS}'
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ if test "$using_gcc" = "yes" ; then
+ LD_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
+ else
+ LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
+ fi
+ ;;
+ ULTRIX-4.*)
+ SHLIB_CFLAGS="-G 0"
+ SHLIB_SUFFIX=".a"
+ SHLIB_LD="echo tclLdAout $CC \{$SHLIB_CFLAGS\} | `pwd`/tclsh -r -G 0"
+ SHLIB_LD_LIBS='${LIBS}'
+ DL_OBJS="tclLoadAout.o"
+ DL_LIBS=""
+ LDFLAGS="-Wl,-D,08000000"
+ LD_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
+ if test "$using_gcc" = "no" ; then
+ EXTRA_CFLAGS="-DHAVE_TZSET -std1"
+ fi
+ ;;
+ UNIX_SV* | UnixWare-5*)
+ SHLIB_CFLAGS="-KPIC"
+ SHLIB_LD="cc -G"
+ SHLIB_LD_LIBS=""
+ SHLIB_SUFFIX=".so"
+ DL_OBJS="tclLoadDl.o"
+ DL_LIBS="-ldl"
+ # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
+ # that don't grok the -Bexport option. Test that it does.
+ hold_ldflags=$LDFLAGS
+ AC_MSG_CHECKING(for ld accepts -Bexport flag)
+ LDFLAGS="${LDFLAGS} -Wl,-Bexport"
+ AC_TRY_LINK(, [int i;], found=yes, found=no)
+ LDFLAGS=$hold_ldflags
+ AC_MSG_RESULT($found)
+ if test $found = yes; then
+ LDFLAGS="-Wl,-Bexport"
+ else
+ LDFLAGS=""
+ fi
+ LD_SEARCH_FLAGS=""
+ ;;
+ esac
+
+ if test "$do64bit" = "yes" -a "$do64bit_ok" = "no" ; then
+ AC_MSG_WARN("64bit support being disabled -- don\'t know magic for this platform")
+ fi
+
+ # Step 4: If pseudo-static linking is in use (see K. B. Kenny, "Dynamic
+ # Loading for Tcl -- What Became of It?". Proc. 2nd Tcl/Tk Workshop,
+ # New Orleans, LA, Computerized Processes Unlimited, 1994), then we need
+ # to determine which of several header files defines the a.out file
+ # format (a.out.h, sys/exec.h, or sys/exec_aout.h). At present, we
+ # support only a file format that is more or less version-7-compatible.
+ # In particular,
+ # - a.out files must begin with `struct exec'.
+ # - the N_TXTOFF on the `struct exec' must compute the seek address
+ # of the text segment
+ # - The `struct exec' must contain a_magic, a_text, a_data, a_bss
+ # and a_entry fields.
+ # The following compilation should succeed if and only if either sys/exec.h
+ # or a.out.h is usable for the purpose.
+ #
+ # Note that the modified COFF format used on MIPS Ultrix 4.x is usable; the
+ # `struct exec' includes a second header that contains information that
+ # duplicates the v7 fields that are needed.
+
+ if test "x$DL_OBJS" = "xtclLoadAout.o" ; then
+ AC_MSG_CHECKING(sys/exec.h)
+ AC_TRY_COMPILE([#include <sys/exec.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_SYS_EXEC_H)
+ else
+ AC_MSG_CHECKING(a.out.h)
+ AC_TRY_COMPILE([#include <a.out.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_magic == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_A_OUT_H)
+ else
+ AC_MSG_CHECKING(sys/exec_aout.h)
+ AC_TRY_COMPILE([#include <sys/exec_aout.h>],[
+ struct exec foo;
+ unsigned long seek;
+ int flag;
+#if defined(__mips) || defined(mips)
+ seek = N_TXTOFF (foo.ex_f, foo.ex_o);
+#else
+ seek = N_TXTOFF (foo);
+#endif
+ flag = (foo.a_midmag == OMAGIC);
+ return foo.a_text + foo.a_data + foo.a_bss + foo.a_entry;
+ ], tcl_ok=usable, tcl_ok=unusable)
+ AC_MSG_RESULT($tcl_ok)
+ if test $tcl_ok = usable; then
+ AC_DEFINE(USE_SYS_EXEC_AOUT_H)
+ else
+ DL_OBJS=""
+ fi
+ fi
+ fi
+ fi
+
+ # Step 5: disable dynamic loading if requested via a command-line switch.
+
+ AC_ARG_ENABLE(load, [ --disable-load disallow dynamic loading and "load" command],
+ [tcl_ok=$enableval], [tcl_ok=yes])
+ if test "$tcl_ok" = "no"; then
+ DL_OBJS=""
+ fi
+
+ if test "x$DL_OBJS" != "x" ; then
+ BUILD_DLTEST="\$(DLTEST_TARGETS)"
+ else
+ echo "Can't figure out how to do dynamic loading or shared libraries"
+ echo "on this system."
+ SHLIB_CFLAGS=""
+ SHLIB_LD=""
+ SHLIB_SUFFIX=""
+ DL_OBJS="tclLoadNone.o"
+ DL_LIBS=""
+ LDFLAGS=""
+ LD_SEARCH_FLAGS=""
+ BUILD_DLTEST=""
+ fi
+
+ # If we're running gcc, then change the C flags for compiling shared
+ # libraries to the right flags for gcc, instead of those for the
+ # standard manufacturer compiler.
+
+ if test "$DL_OBJS" != "tclLoadNone.o" ; then
+ if test "$using_gcc" = "yes" ; then
+ case $system in
+ AIX-*)
+ ;;
+ BSD/OS*)
+ ;;
+ IRIX*)
+ ;;
+ NetBSD-*|FreeBSD-*|OpenBSD-*)
+ ;;
+ RISCos-*)
+ ;;
+ SCO_SV-3.2*)
+ ;;
+ ULTRIX-4.*)
+ ;;
+ *)
+ SHLIB_CFLAGS="-fPIC"
+ ;;
+ esac
+ fi
+ fi
+
+ if test "$SHARED_LIB_SUFFIX" = "" ; then
+ SHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}${SHLIB_SUFFIX}'
+ fi
+ if test "$UNSHARED_LIB_SUFFIX" = "" ; then
+ UNSHARED_LIB_SUFFIX='${VERSION}\$\{DBGX\}.a'
+ fi
+
+# CYGNUS LOCAL
+ TCL_LIB_SUFFIX=.a
+ AC_SUBST(TCL_LIB_SUFFIX)
+# END CYGNUS LOCAL
+
+ AC_SUBST(DL_LIBS)
+ AC_SUBST(CFLAGS_DEBUG)
+ AC_SUBST(CFLAGS_OPTIMIZE)
+ AC_SUBST(CFLAGS_WARNING)
+])
+
+#--------------------------------------------------------------------
+# SC_SERIAL_PORT
+#
+# 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.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines only one of the following vars:
+# USE_TERMIOS
+# USE_TERMIO
+# USE_SGTTY
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_SERIAL_PORT, [
+ AC_MSG_CHECKING([termios vs. termio vs. sgtty])
+
+ AC_TRY_RUN([
+#include <termios.h>
+
+main()
+{
+ struct termios t;
+ if (tcgetattr(0, &t) == 0) {
+ cfsetospeed(&t, 0);
+ t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+}], tk_ok=termios, tk_ok=no, tk_ok=no)
+
+ if test $tk_ok = termios; then
+ AC_DEFINE(USE_TERMIOS)
+ else
+ AC_TRY_RUN([
+#include <termio.h>
+
+main()
+{
+ struct termio t;
+ if (ioctl(0, TCGETA, &t) == 0) {
+ t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
+ return 0;
+ }
+ return 1;
+ }], tk_ok=termio, tk_ok=no, tk_ok=no)
+
+ if test $tk_ok = termio; then
+ AC_DEFINE(USE_TERMIO)
+ else
+ AC_TRY_RUN([
+#include <sgtty.h>
+
+main()
+{
+ struct sgttyb t;
+ if (ioctl(0, TIOCGETP, &t) == 0) {
+ t.sg_ospeed = 0;
+ t.sg_flags |= ODDP | EVENP | RAW;
+ return 0;
+ }
+ return 1;
+}], tk_ok=sgtty, tk_ok=none, tk_ok=none)
+ if test $tk_ok = sgtty; then
+ AC_DEFINE(USE_SGTTY)
+ fi
+ fi
+ fi
+ AC_MSG_RESULT($tk_ok)
+])
+
+#--------------------------------------------------------------------
+# SC_MISSING_POSIX_HEADERS
+#
+# 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
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# NO_DIRENT_H
+# NO_ERRNO_H
+# NO_VALUES_H
+# NO_LIMITS_H
+# NO_STDLIB_H
+# NO_STRING_H
+# NO_SYS_WAIT_H
+# NO_DLFCN_H
+# HAVE_UNISTD_H
+# HAVE_SYS_PARAM_H
+#
+# HAVE_STRING_H ?
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_MISSING_POSIX_HEADERS, [
+
+ AC_MSG_CHECKING(dirent.h)
+ AC_TRY_LINK([#include <sys/types.h>
+#include <dirent.h>], [
+#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);
+], tcl_ok=yes, tcl_ok=no)
+
+ if test $tcl_ok = no; then
+ AC_DEFINE(NO_DIRENT_H)
+ fi
+
+ AC_MSG_RESULT($tcl_ok)
+ AC_CHECK_HEADER(errno.h, , AC_DEFINE(NO_ERRNO_H))
+ AC_CHECK_HEADER(float.h, , AC_DEFINE(NO_FLOAT_H))
+ AC_CHECK_HEADER(values.h, , AC_DEFINE(NO_VALUES_H))
+ AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
+ AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
+ AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
+ AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
+ AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
+ if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STDLIB_H)
+ fi
+ AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
+ AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
+ AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)
+
+ # See also memmove check below for a place where NO_STRING_H can be
+ # set and why.
+
+ if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STRING_H)
+ fi
+
+ AC_CHECK_HEADER(sys/wait.h, , AC_DEFINE(NO_SYS_WAIT_H))
+ AC_CHECK_HEADER(dlfcn.h, , AC_DEFINE(NO_DLFCN_H))
+
+ # OS/390 lacks sys/param.h (and doesn't need it, by chance).
+
+ AC_HAVE_HEADERS(unistd.h sys/param.h)
+
+])
+
+#--------------------------------------------------------------------
+# SC_PATH_X
+#
+# 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.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Sets the the following vars:
+# XINCLUDES
+# XLIBSW
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_X, [
+ AC_PATH_X
+ not_really_there=""
+ if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes")
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+ fi
+ if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ AC_MSG_CHECKING(for X11 header files)
+ XINCLUDES="# no special path needed"
+ AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ AC_MSG_RESULT($i)
+ XINCLUDES=" -I$i"
+ break
+ fi
+ done
+ fi
+ else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+ fi
+ if test "$XINCLUDES" = nope; then
+ AC_MSG_RESULT(couldn't find any!)
+ XINCLUDES="# no include files found"
+ fi
+
+ if test "$no_x" = yes; then
+ AC_MSG_CHECKING(for X11 libraries)
+ XLIBSW=nope
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
+ AC_MSG_RESULT($i)
+ XLIBSW="-L$i -lX11"
+ x_libraries="$i"
+ break
+ fi
+ done
+ else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+ fi
+ if test "$XLIBSW" = nope ; then
+ AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow)
+ fi
+ if test "$XLIBSW" = nope ; then
+ AC_MSG_RESULT(couldn't find any! Using -lX11.)
+ XLIBSW=-lX11
+ fi
+])
+#--------------------------------------------------------------------
+# SC_BLOCKING_STYLE
+#
+# 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.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# HAVE_SYS_IOCTL_H
+# HAVE_SYS_FILIO_H
+# USE_FIONBIO
+# O_NONBLOCK
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_BLOCKING_STYLE, [
+ AC_CHECK_HEADERS(sys/ioctl.h)
+ AC_CHECK_HEADERS(sys/filio.h)
+ AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
+ 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
+ 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 $3}' /etc/.relid'`
+ fi
+ if test "`uname -s`" = "AIX" ; then
+ system=AIX-`uname -v`.`uname -r`
+ fi
+ 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).
+
+ OSF*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ SunOS-4*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ ULTRIX-4.*)
+ AC_DEFINE(USE_FIONBIO)
+ AC_MSG_RESULT(FIONBIO)
+ ;;
+ *)
+ AC_MSG_RESULT(O_NONBLOCK)
+ ;;
+ esac
+])
+
+#--------------------------------------------------------------------
+# SC_HAVE_VFORK
+#
+# Check to see whether the system provides a vfork kernel call.
+# If not, then use fork instead. Also, check for a problem with
+# vforks and signals that can cause core dumps if a vforked child
+# resets a signal handler. If the problem exists, then use fork
+# instead of vfork.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# vfork (=fork)
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_HAVE_VFORK, [
+ AC_TYPE_SIGNAL()
+ AC_CHECK_FUNC(vfork, tcl_ok=1, tcl_ok=0)
+ if test "$tcl_ok" = 1; then
+ AC_MSG_CHECKING([vfork/signal bug]);
+ AC_TRY_RUN([
+#include <stdio.h>
+#include <signal.h>
+#include <sys/wait.h>
+int gotSignal = 0;
+sigProc(sig)
+ int sig;
+{
+ gotSignal = 1;
+}
+main()
+{
+ int pid, sts;
+ (void) signal(SIGCHLD, sigProc);
+ pid = vfork();
+ if (pid < 0) {
+ exit(1);
+ } else if (pid == 0) {
+ (void) signal(SIGCHLD, SIG_DFL);
+ _exit(0);
+ } else {
+ (void) wait(&sts);
+ }
+ exit((gotSignal) ? 0 : 1);
+}], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+
+ if test "$tcl_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT([buggy, using fork instead])
+ fi
+ fi
+ rm -f core
+ if test "$tcl_ok" = 0; then
+ AC_DEFINE(vfork, fork)
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_TIME_HANLDER
+#
+# Checks how the system deals with time.h, what time structures
+# are used on the system, and what fields the structures have.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# USE_DELTA_FOR_TZ
+# HAVE_TM_GMTOFF
+# HAVE_TM_TZADJ
+# HAVE_TIMEZONE_VAR
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TIME_HANDLER, [
+ AC_CHECK_HEADERS(sys/time.h)
+ AC_HEADER_TIME
+ AC_STRUCT_TIMEZONE
+
+ AC_MSG_CHECKING([tm_tzadj in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
+ [AC_DEFINE(HAVE_TM_TZADJ)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ AC_MSG_CHECKING([tm_gmtoff in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
+ [AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
+ #
+ have_timezone=no
+ AC_MSG_CHECKING([long timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern long timezone;
+ timezone += 1;
+ exit (0);],
+ [have_timezone=yes
+ AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ if test "$have_timezone" = no; then
+ AC_MSG_CHECKING([time_t timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern time_t timezone;
+ timezone += 1;
+ exit (0);],
+ [AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+ fi
+
+ #
+ # On some systems (eg Solaris 2.5.1), timezone is not declared in
+ # time.h unless you jump through hoops. Instead of that, we just
+ # declare it ourselves when necessary.
+ #
+ if test "$have_timezone" = yes; then
+ AC_MSG_CHECKING(for timezone declaration)
+ changequote(<<,>>)
+ tzrx='^[ ]*extern.*timezone'
+ changequote([,])
+ AC_EGREP_HEADER($tzrx, time.h, [
+ AC_DEFINE(HAVE_TIMEZONE_DECL)
+ AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
+ fi
+
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX bsd
+ # library is used, the timezone global and the gettimeofday methods are
+ # to be avoided for timezone deduction instead, we deduce the timezone
+ # by comparing the localtime result on a known GMT value.
+ #
+
+ if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ AC_DEFINE(USE_DELTA_FOR_TZ)
+ fi
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_BUGGY_STRTOD
+#
+# 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.
+# Also, on Compaq's Tru64 Unix 5.0,
+# strtod(" ") returns 0.0 instead of a failure to convert.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Might defines some of the following vars:
+# strtod (=fixstrtod)
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_BUGGY_STRTOD, [
+ AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
+ if test "$tcl_strtod" = 1; then
+ AC_MSG_CHECKING([for Solaris2.4/Tru64 strtod bugs])
+ AC_TRY_RUN([
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN", *spaceString = " ";
+ char *term;
+ double value;
+ value = strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ value = strtod(spaceString, &term);
+ if (term == (spaceString+1)) {
+ exit(1);
+ }
+ exit(0);
+ }], tcl_ok=1, tcl_ok=0, tcl_ok=0)
+ if test "$tcl_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT(buggy)
+ LIBOBJS="$LIBOBJS fixstrtod.o"
+ AC_DEFINE(strtod, fixstrtod)
+ fi
+ fi
+])
+
+#--------------------------------------------------------------------
+# SC_TCL_LINK_LIBS
+#
+# Search for the libraries needed to link the Tcl shell.
+# Things like the math library (-lm) and socket stuff (-lsocket vs.
+# -lnsl) are dealt with here.
+#
+# Arguments:
+# Requires the following vars to be set in the Makefile:
+# DL_LIBS
+# LIBS
+# MATH_LIBS
+#
+# Results:
+#
+# Subst's the following var:
+# TCL_LIBS
+# MATH_LIBS
+#
+# Might append to the following vars:
+# LIBS
+#
+# Might define the following vars:
+# HAVE_NET_ERRNO_H
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TCL_LINK_LIBS, [
+ #--------------------------------------------------------------------
+ # 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_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
+ AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])
+
+ #--------------------------------------------------------------------
+ # 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
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ MATH_LIBS="$MATH_LIBS -lbsd"
+ fi
+ fi
+
+
+ #--------------------------------------------------------------------
+ # Interactive UNIX requires -linet instead of -lsocket, plus it
+ # needs net/errno.h to define the socket-related error codes.
+ #--------------------------------------------------------------------
+
+ AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
+ AC_CHECK_HEADER(net/errno.h, AC_DEFINE(HAVE_NET_ERRNO_H))
+
+ #--------------------------------------------------------------------
+ # 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.
+ #--------------------------------------------------------------------
+
+ # CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+ # mess up the cache values of the functions we check for.
+ AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
+ [tcl_cv_lib_sockets=
+ tcl_checkBoth=0
+ unset ac_cv_func_connect
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ unset ac_cv_func_connect
+ AC_CHECK_LIB(socket, main, tcl_cv_lib_sockets="-lsocket",
+ tcl_checkBoth=1)
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tcl_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ unset ac_cv_func_accept
+ AC_CHECK_FUNC(accept,
+ [tcl_checkNsl=0
+ tcl_cv_lib_sockets="-lsocket -lnsl"])
+ unset ac_cv_func_accept
+ LIBS=$tcl_oldLibs
+ fi
+ unset ac_cv_func_gethostbyname
+ tcl_oldLibs=$LIBS
+ LIBS="$LIBS $tcl_cv_lib_sockets"
+ AC_CHECK_FUNC(gethostbyname, ,
+ [AC_CHECK_LIB(nsl, main,
+ [tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"])])
+ unset ac_cv_func_gethostbyname
+ LIBS=$tcl_oldLIBS
+ ])
+ test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+ # 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}'
+ AC_SUBST(TCL_LIBS)
+ AC_SUBST(MATH_LIBS)
+])
+
+dnl CYGNUS LOCAL: This gets the right posix flag for gcc
+
+AC_DEFUN(CY_AC_TCL_LYNX_POSIX,
+[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP])
+AC_MSG_CHECKING([to see if this is LynxOS])
+AC_CACHE_VAL(ac_cv_os_lynx,
+[AC_EGREP_CPP(yes,
+[/*
+ * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
+ */
+#if defined(__Lynx__) || defined(Lynx)
+yes
+#endif
+], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)])
+#
+if test "$ac_cv_os_lynx" = "yes" ; then
+ AC_MSG_RESULT(yes)
+ AC_DEFINE(LYNX)
+ AC_MSG_CHECKING([whether -mposix or -X is available])
+ AC_CACHE_VAL(ac_cv_c_posix_flag,
+ [AC_TRY_COMPILE(,[
+ /*
+ * This flag varies depending on how old the compiler is.
+ * -X is for the old "cc" and "gcc" (based on 1.42).
+ * -mposix is for the new gcc (at least 2.5.8).
+ */
+ #if defined(__GNUC__) && __GNUC__ >= 2
+ choke me
+ #endif
+ ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")])
+ CC="$CC $ac_cv_c_posix_flag"
+ AC_MSG_RESULT($ac_cv_c_posix_flag)
+ else
+ AC_MSG_RESULT(no)
+fi
+])
diff --git a/tk/unix/tkAppInit.c b/tk/unix/tkAppInit.c
index 19fcd974fbc..ca7febb4453 100644
--- a/tk/unix/tkAppInit.c
+++ b/tk/unix/tkAppInit.c
@@ -5,7 +5,7 @@
* use in wish and similar Tk-based applications.
*
* Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
+ * 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.
@@ -14,6 +14,7 @@
*/
#include "tk.h"
+#include "locale.h"
/*
* The following variable is a special hack that is needed in order for
@@ -24,7 +25,8 @@ extern int matherr();
int *tclDummyMathPtr = (int *) matherr;
#ifdef TK_TEST
-EXTERN int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */
/*
@@ -49,7 +51,30 @@ main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
- Tk_Main(argc, argv, Tcl_AppInit);
+ /*
+ * 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. */
}
@@ -64,7 +89,7 @@ main(argc, argv)
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -84,6 +109,11 @@ Tcl_AppInit(interp)
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
#ifdef TK_TEST
+ if (Tcltest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
+ (Tcl_PackageInitProc *) NULL);
if (Tktest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -118,3 +148,4 @@ Tcl_AppInit(interp)
Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
+
diff --git a/tk/unix/tkConfig.sh.in b/tk/unix/tkConfig.sh.in
index 1caab785751..faa90d29203 100644
--- a/tk/unix/tkConfig.sh.in
+++ b/tk/unix/tkConfig.sh.in
@@ -25,6 +25,9 @@ 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@'
@@ -54,6 +57,9 @@ 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@'
@@ -75,3 +81,23 @@ TK_SRC_DIR='@TK_SRC_DIR@'
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/tk/unix/tkUnix.c b/tk/unix/tkUnix.c
index 097b1b27828..3b099540eed 100644
--- a/tk/unix/tkUnix.c
+++ b/tk/unix/tkUnix.c
@@ -40,7 +40,8 @@ TkGetServerInfo(interp, tkwin)
Tk_Window tkwin; /* Token for window; this selects a
* particular display and server. */
{
- char buffer[50], buffer2[50];
+ 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)));
@@ -77,3 +78,32 @@ TkGetDefaultScreenName(interp, screenName)
}
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/tk/unix/tkUnix3d.c b/tk/unix/tkUnix3d.c
index b3493a79f28..9cab15094ed 100644
--- a/tk/unix/tkUnix3d.c
+++ b/tk/unix/tkUnix3d.c
@@ -14,6 +14,10 @@
#include <tk3d.h>
+#if !defined(__WIN32__) && !defined(MAC_TCL)
+#include "tkUnixInt.h"
+#endif
+
/*
* This structure is used to keep track of the extra colors used
* by Unix 3d borders.
@@ -335,6 +339,7 @@ TkpGetShadows(borderPtr, tkwin)
{
XColor lightColor, darkColor;
int stressed, tmp1, tmp2;
+ int r, g, b;
XGCValues gcValues;
if (borderPtr->lightGC != None) {
@@ -356,42 +361,81 @@ TkpGetShadows(borderPtr, tkwin)
/*
* 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
*/
- darkColor.red = (60 * (int) borderPtr->bgColorPtr->red)/100;
- darkColor.green = (60 * (int) borderPtr->bgColorPtr->green)/100;
- darkColor.blue = (60 * (int) borderPtr->bgColorPtr->blue)/100;
borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
gcValues.foreground = borderPtr->darkColorPtr->pixel;
borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
/*
- * Compute the colors using integers, not using lightColor.red
- * etc.: these are shorts and may have problems with integer
- * overflow.
+ * Compute the light shadow color
*/
- tmp1 = (14 * (int) borderPtr->bgColorPtr->red)/10;
- if (tmp1 > MAX_INTENSITY) {
- tmp1 = MAX_INTENSITY;
- }
- tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->red)/2;
- lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
- tmp1 = (14 * (int) borderPtr->bgColorPtr->green)/10;
- if (tmp1 > MAX_INTENSITY) {
- tmp1 = MAX_INTENSITY;
- }
- tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->green)/2;
- lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
- tmp1 = (14 * (int) borderPtr->bgColorPtr->blue)/10;
- if (tmp1 > MAX_INTENSITY) {
- tmp1 = MAX_INTENSITY;
+ 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;
}
- tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->blue)/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);
@@ -446,3 +490,5 @@ TkpGetShadows(borderPtr, tkwin)
borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
}
}
+
+
diff --git a/tk/unix/tkUnixButton.c b/tk/unix/tkUnixButton.c
index 5a8acc03671..5f15d51fae5 100644
--- a/tk/unix/tkUnixButton.c
+++ b/tk/unix/tkUnixButton.c
@@ -4,7 +4,7 @@
* This file implements the Unix specific portion of the button
* widgets.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * 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.
@@ -85,12 +85,11 @@ TkpDisplayButton(clientData)
int x = 0; /* Initialization only needed to stop
* compiler warning. */
int y, relief;
- register Tk_Window tkwin = butPtr->tkwin;
+ Tk_Window tkwin = butPtr->tkwin;
int width, height;
- int offset; /* 0 means this is a label widget. 1 means
- * it is a flavor of button, so we offset
- * the text to make the button appear to
- * move up and down as the relief changes. */
+ 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)) {
@@ -98,16 +97,16 @@ TkpDisplayButton(clientData)
}
border = butPtr->normalBorder;
- if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
gc = butPtr->disabledGC;
- } else if ((butPtr->state == tkActiveUid)
+ } 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 != tkActiveUid)
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
&& (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
border = butPtr->selectBorder;
}
@@ -141,7 +140,7 @@ TkpDisplayButton(clientData)
* Display image or bitmap or text for button.
*/
- if (butPtr->image != None) {
+ if (butPtr->image != NULL) {
Tk_SizeOfImage(butPtr->image, &width, &height);
imageOrBitmap:
@@ -213,7 +212,7 @@ TkpDisplayButton(clientData)
y -= dim/2;
if (dim > 2*butPtr->borderWidth) {
Tk_Draw3DRectangle(tkwin, pixmap, border, x, y, dim, dim,
- butPtr->borderWidth,
+ butPtr->borderWidth,
(butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN :
TK_RELIEF_RAISED);
x += butPtr->borderWidth;
@@ -222,7 +221,7 @@ TkpDisplayButton(clientData)
if (butPtr->flags & SELECTED) {
GC gc;
- gc = Tk_3DBorderGC(tkwin,(butPtr->selectBorder != NULL)
+ gc = Tk_3DBorderGC(tkwin, (butPtr->selectBorder != NULL)
? butPtr->selectBorder : butPtr->normalBorder,
TK_3D_FLAT_GC);
XFillRectangle(butPtr->display, pixmap, gc, x, y,
@@ -269,7 +268,7 @@ TkpDisplayButton(clientData)
* must temporarily modify the GC.
*/
- if ((butPtr->state == tkDisabledUid)
+ if ((butPtr->state == STATE_DISABLED)
&& ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
&& (butPtr->selectBorder != NULL)) {
@@ -297,7 +296,8 @@ TkpDisplayButton(clientData)
if (relief != TK_RELIEF_FLAT) {
int inset = butPtr->highlightWidth;
- if (butPtr->defaultState == tkActiveUid) {
+
+ 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
@@ -319,15 +319,14 @@ TkpDisplayButton(clientData)
Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT);
inset += 2;
- } else if (butPtr->defaultState == tkNormalUid) {
+ } 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);
+ 0, Tk_Width(tkwin), Tk_Height(tkwin), 5, TK_RELIEF_FLAT);
inset += 5;
}
@@ -339,7 +338,7 @@ TkpDisplayButton(clientData)
Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
butPtr->borderWidth, relief);
}
- if (butPtr->highlightWidth != 0) {
+ if (butPtr->highlightWidth > 0) {
GC gc;
if (butPtr->flags & GOT_FOCUS) {
@@ -354,7 +353,7 @@ TkpDisplayButton(clientData)
* padding space left for a default ring.
*/
- if (butPtr->defaultState == tkNormalUid) {
+ if (butPtr->defaultState == DEFAULT_NORMAL) {
TkDrawInsetFocusHighlight(tkwin, gc, butPtr->highlightWidth,
pixmap, 5);
} else {
@@ -398,16 +397,13 @@ TkpComputeButtonGeometry(butPtr)
int width, height, avgWidth;
Tk_FontMetrics fm;
- if (butPtr->highlightWidth < 0) {
- butPtr->highlightWidth = 0;
- }
butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
/*
* Leave room for the default ring if needed.
*/
- if (butPtr->defaultState != tkDisabledUid) {
+ if (butPtr->defaultState != DEFAULT_DISABLED) {
butPtr->inset += 5;
}
butPtr->indicatorSpace = 0;
@@ -433,9 +429,10 @@ TkpComputeButtonGeometry(butPtr)
goto imageOrBitmap;
} else {
Tk_FreeTextLayout(butPtr->textLayout);
+
butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
- butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0,
- &butPtr->textWidth, &butPtr->textHeight);
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
width = butPtr->textWidth;
height = butPtr->textHeight;
@@ -476,3 +473,4 @@ TkpComputeButtonGeometry(butPtr)
+ 2*butPtr->inset), (int) (height + 2*butPtr->inset));
Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
}
+
diff --git a/tk/unix/tkUnixColor.c b/tk/unix/tkUnixColor.c
index d927351833b..ef3d77a4669 100644
--- a/tk/unix/tkUnixColor.c
+++ b/tk/unix/tkUnixColor.c
@@ -422,3 +422,4 @@ TkpCmapStressed(tkwin, colormap)
}
return 0;
}
+
diff --git a/tk/unix/tkUnixConfig.c b/tk/unix/tkUnixConfig.c
new file mode 100644
index 00000000000..9db523a9d40
--- /dev/null
+++ b/tk/unix/tkUnixConfig.c
@@ -0,0 +1,46 @@
+/*
+ * 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. */
+ char *dbName; /* The option database name. */
+ char *className; /* The name of the option class. */
+{
+ return NULL;
+}
+
diff --git a/tk/unix/tkUnixCursor.c b/tk/unix/tkUnixCursor.c
index eb6e46030b5..54915b9c92c 100644
--- a/tk/unix/tkUnixCursor.c
+++ b/tk/unix/tkUnixCursor.c
@@ -3,7 +3,7 @@
*
* This file contains X specific cursor manipulation routines.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * 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.
@@ -218,7 +218,7 @@ TkGetCursorByName(interp, tkwin, string)
if (dispPtr->cursorFont == None) {
dispPtr->cursorFont = XLoadFont(display, CURSORFONT);
if (dispPtr->cursorFont == None) {
- interp->result = "couldn't load cursor font";
+ Tcl_SetResult(interp, "couldn't load cursor font", TCL_STATIC);
goto cleanup;
}
}
@@ -282,8 +282,9 @@ TkGetCursorByName(interp, tkwin, string)
goto cleanup;
}
if ((maskWidth != width) && (maskHeight != height)) {
- interp->result =
- "source and mask bitmaps have different sizes";
+ Tcl_SetResult(interp,
+ "source and mask bitmaps have different sizes",
+ TCL_STATIC);
goto cleanup;
}
if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
@@ -323,6 +324,9 @@ TkGetCursorByName(interp, tkwin, string)
badString:
+ if (argv) {
+ ckfree((char *) argv);
+ }
Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
(char *) NULL);
return NULL;
@@ -382,7 +386,7 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
/*
*----------------------------------------------------------------------
*
- * TkFreeCursor --
+ * TkpFreeCursor --
*
* This procedure is called to release a cursor allocated by
* TkGetCursorByName.
@@ -397,11 +401,11 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
*/
void
-TkFreeCursor(cursorPtr)
+TkpFreeCursor(cursorPtr)
TkCursor *cursorPtr;
{
TkUnixCursor *unixCursorPtr = (TkUnixCursor *) cursorPtr;
XFreeCursor(unixCursorPtr->display, (Cursor) unixCursorPtr->info.cursor);
Tk_FreeXId(unixCursorPtr->display, (XID) unixCursorPtr->info.cursor);
- ckfree((char *) unixCursorPtr);
}
+
diff --git a/tk/unix/tkUnixDefault.h b/tk/unix/tkUnixDefault.h
index bc9e0ac8ea8..0bc3f966b1b 100644
--- a/tk/unix/tkUnixDefault.h
+++ b/tk/unix/tkUnixDefault.h
@@ -59,7 +59,8 @@
#define DEF_CHKRAD_FG DEF_BUTTON_FG
#define DEF_BUTTON_FONT "Helvetica -12 bold"
#define DEF_BUTTON_HEIGHT "0"
-#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_BUTTON_HIGHLIGHT_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"
@@ -197,6 +198,7 @@
#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"
@@ -282,7 +284,8 @@
#define DEF_MENUBUTTON_FONT "Helvetica -12 bold"
#define DEF_MENUBUTTON_FG BLACK
#define DEF_MENUBUTTON_HEIGHT "0"
-#define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MENUBUTTON_HIGHLIGHT_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
@@ -341,14 +344,15 @@
#define DEF_SCALE_FG_COLOR BLACK
#define DEF_SCALE_FG_MONO BLACK
#define DEF_SCALE_FROM "0"
-#define DEF_SCALE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCALE_HIGHLIGHT_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_DELAY "300"
#define DEF_SCALE_REPEAT_INTERVAL "100"
#define DEF_SCALE_RESOLUTION "1"
#define DEF_SCALE_TROUGH_COLOR TROUGH
@@ -449,3 +453,4 @@
#define DEF_TOPLEVEL_SCREEN ""
#endif /* _TKUNIXDEFAULT */
+
diff --git a/tk/unix/tkUnixDialog.c b/tk/unix/tkUnixDialog.c
index 81bcb840759..b9554327af0 100644
--- a/tk/unix/tkUnixDialog.c
+++ b/tk/unix/tkUnixDialog.c
@@ -126,7 +126,6 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv)
*
*----------------------------------------------------------------------
*/
-int SN_donot_call_motif_filedialog_box = 0;
int
Tk_GetOpenFileCmd(clientData, interp, argc, argv)
@@ -137,8 +136,7 @@ Tk_GetOpenFileCmd(clientData, interp, argc, argv)
{
Tk_Window tkwin = (Tk_Window)clientData;
- /* Don't use motif dialog box */
- if (SN_donot_call_motif_filedialog_box == 0 && Tk_StrictMotif(tkwin)) {
+ if (Tk_StrictMotif(tkwin)) {
return EvalArgv(interp, "tkMotifFDialog", argc, argv);
} else {
return EvalArgv(interp, "tkFDialog", argc, argv);
@@ -171,8 +169,7 @@ Tk_GetSaveFileCmd(clientData, interp, argc, argv)
{
Tk_Window tkwin = (Tk_Window)clientData;
- /* Don't use motif dialog box */
- if (SN_donot_call_motif_filedialog_box == 0 && Tk_StrictMotif(tkwin)) {
+ if (Tk_StrictMotif(tkwin)) {
return EvalArgv(interp, "tkMotifFDialog", argc, argv);
} else {
return EvalArgv(interp, "tkFDialog", argc, argv);
@@ -208,3 +205,4 @@ Tk_MessageBoxCmd(clientData, interp, argc, argv)
return EvalArgv(interp, "tkMessageBox", argc, argv);
}
+
diff --git a/tk/unix/tkUnixDraw.c b/tk/unix/tkUnixDraw.c
index 42aa3560b88..2a135aa4036 100644
--- a/tk/unix/tkUnixDraw.c
+++ b/tk/unix/tkUnixDraw.c
@@ -14,6 +14,10 @@
#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.
@@ -168,4 +172,37 @@ ScrollRestrictProc(arg, eventPtr)
}
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/tk/unix/tkUnixEmbed.c b/tk/unix/tkUnixEmbed.c
index fb8fe3f5679..e52a06226de 100644
--- a/tk/unix/tkUnixEmbed.c
+++ b/tk/unix/tkUnixEmbed.c
@@ -46,9 +46,11 @@ typedef struct Container {
* this process. */
} Container;
-static Container *firstContainerPtr = NULL;
- /* First in list of all containers
+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:
@@ -83,7 +85,7 @@ static void EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr));
* Results:
* The return value is normally TCL_OK. If an error occurs (such
* as string not being a valid window spec), then the return value
- * is TCL_ERROR and an error message is left in interp->result if
+ * is TCL_ERROR and an error message is left in the interp's result if
* interp is non-NULL.
*
* Side effects:
@@ -108,6 +110,8 @@ TkpUseWindow(interp, tkwin, string)
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");
@@ -157,7 +161,7 @@ TkpUseWindow(interp, tkwin, string)
* app. are in the same process.
*/
- for (containerPtr = firstContainerPtr; containerPtr != NULL;
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
containerPtr = containerPtr->nextPtr) {
if (containerPtr->parent == parent) {
winPtr->flags |= TK_BOTH_HALVES;
@@ -171,8 +175,8 @@ TkpUseWindow(interp, tkwin, string)
containerPtr->parentRoot = parentAtts.root;
containerPtr->parentPtr = NULL;
containerPtr->wrapper = None;
- containerPtr->nextPtr = firstContainerPtr;
- firstContainerPtr = containerPtr;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
}
containerPtr->embeddedPtr = winPtr;
winPtr->flags |= TK_EMBEDDED;
@@ -204,6 +208,8 @@ TkpMakeWindow(winPtr, parent)
* which the window is to be created. */
{
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr->flags & TK_EMBEDDED) {
/*
@@ -213,7 +219,7 @@ TkpMakeWindow(winPtr, parent)
* into a wrapper window later.
*/
- for (containerPtr = firstContainerPtr; ;
+ for (containerPtr = tsdPtr->firstContainerPtr; ;
containerPtr = containerPtr->nextPtr) {
if (containerPtr == NULL) {
panic("TkMakeWindow couldn't find container for window");
@@ -259,6 +265,8 @@ TkpMakeContainer(tkwin)
{
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
@@ -272,8 +280,8 @@ TkpMakeContainer(tkwin)
containerPtr->parentPtr = winPtr;
containerPtr->wrapper = None;
containerPtr->embeddedPtr = NULL;
- containerPtr->nextPtr = firstContainerPtr;
- firstContainerPtr = containerPtr;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
winPtr->flags |= TK_CONTAINER;
/*
@@ -383,6 +391,8 @@ ContainerEventProc(clientData, eventPtr)
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
@@ -397,7 +407,7 @@ ContainerEventProc(clientData, eventPtr)
* Find the Container structure associated with the parent window.
*/
- for (containerPtr = firstContainerPtr;
+ for (containerPtr = tsdPtr->firstContainerPtr;
containerPtr->parent != eventPtr->xmaprequest.parent;
containerPtr = containerPtr->nextPtr) {
if (containerPtr == NULL) {
@@ -697,8 +707,11 @@ TkpGetOtherWindow(winPtr)
* embedded window. */
{
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (containerPtr = firstContainerPtr; containerPtr != NULL;
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL;
containerPtr = containerPtr->nextPtr) {
if (containerPtr->embeddedPtr == winPtr) {
return containerPtr->parentPtr;
@@ -741,6 +754,8 @@ TkpRedirectKeyEvent(winPtr, eventPtr)
{
Container *containerPtr;
Window saved;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* First, find the top-level window corresponding to winPtr.
@@ -769,7 +784,7 @@ TkpRedirectKeyEvent(winPtr, eventPtr)
* application. Send the event back to the container.
*/
- for (containerPtr = firstContainerPtr;
+ for (containerPtr = tsdPtr->firstContainerPtr;
containerPtr->embeddedPtr != winPtr;
containerPtr = containerPtr->nextPtr) {
/* Empty loop body. */
@@ -811,12 +826,14 @@ TkpClaimFocus(topLevelPtr, force)
{
XEvent event;
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (!(topLevelPtr->flags & TK_EMBEDDED)) {
return;
}
- for (containerPtr = firstContainerPtr;
+ for (containerPtr = tsdPtr->firstContainerPtr;
containerPtr->embeddedPtr != topLevelPtr;
containerPtr = containerPtr->nextPtr) {
/* Empty loop body. */
@@ -861,6 +878,8 @@ TkpTestembedCmd(clientData, interp, argc, argv)
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;
@@ -868,7 +887,7 @@ TkpTestembedCmd(clientData, interp, argc, argv)
all = 0;
}
Tcl_DStringInit(&dString);
- for (containerPtr = firstContainerPtr; containerPtr != NULL;
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
containerPtr = containerPtr->nextPtr) {
Tcl_DStringStartSublist(&dString);
if (containerPtr->parent == None) {
@@ -933,6 +952,8 @@ EmbedWindowDeleted(winPtr)
* was deleted. */
{
Container *containerPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Find the Container structure for this window work. Delete the
@@ -941,7 +962,7 @@ EmbedWindowDeleted(winPtr)
*/
prevPtr = NULL;
- containerPtr = firstContainerPtr;
+ containerPtr = tsdPtr->firstContainerPtr;
while (1) {
if (containerPtr->embeddedPtr == winPtr) {
containerPtr->wrapper = None;
@@ -958,7 +979,7 @@ EmbedWindowDeleted(winPtr)
if ((containerPtr->embeddedPtr == NULL)
&& (containerPtr->parentPtr == NULL)) {
if (prevPtr == NULL) {
- firstContainerPtr = containerPtr->nextPtr;
+ tsdPtr->firstContainerPtr = containerPtr->nextPtr;
} else {
prevPtr->nextPtr = containerPtr->nextPtr;
}
@@ -989,9 +1010,11 @@ TkUnixContainerId(winPtr)
TkWindow *winPtr; /* Tk's structure for an embedded window. */
{
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (containerPtr = firstContainerPtr; containerPtr != NULL;
- containerPtr = containerPtr->nextPtr) {
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
if (containerPtr->embeddedPtr == winPtr) {
return containerPtr->parent;
}
@@ -999,3 +1022,4 @@ TkUnixContainerId(winPtr)
panic("TkUnixContainerId couldn't find window");
return None;
}
+
diff --git a/tk/unix/tkUnixEvent.c b/tk/unix/tkUnixEvent.c
index fbb99cd1598..f90963be892 100644
--- a/tk/unix/tkUnixEvent.c
+++ b/tk/unix/tkUnixEvent.c
@@ -17,10 +17,14 @@
#include <signal.h>
/*
- * The following static indicates whether this module has been initialized.
+ * The following static indicates whether this module has been initialized
+ * in the current thread.
*/
-static int initialized = 0;
+typedef struct ThreadSpecificData {
+ int initialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* Prototypes for procedures that are referenced only in this file:
@@ -34,6 +38,8 @@ 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));
+
/*
*----------------------------------------------------------------------
@@ -55,8 +61,11 @@ static void DisplaySetupProc _ANSI_ARGS_((ClientData clientData,
void
TkCreateXEventSource()
{
- if (!initialized) {
- initialized = 1;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
Tcl_CreateExitHandler(DisplayExitHandler, NULL);
}
@@ -83,8 +92,11 @@ static void
DisplayExitHandler(clientData)
ClientData clientData; /* Not used. */
{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
- initialized = 0;
+ tsdPtr->initialized = 0;
}
/*
@@ -185,7 +197,7 @@ DisplaySetupProc(clientData, flags)
return;
}
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
/*
@@ -196,7 +208,7 @@ DisplaySetupProc(clientData, flags)
*/
XFlush(dispPtr->display);
- if (XQLength(dispPtr->display) > 0) {
+ if (QLength(dispPtr->display) > 0) {
Tcl_SetMaxBlockTime(&blockTime);
}
}
@@ -205,6 +217,43 @@ DisplaySetupProc(clientData, flags)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -225,29 +274,19 @@ DisplayCheckProc(clientData, flags)
int flags;
{
TkDisplay *dispPtr;
- XEvent event;
- int numFound;
if (!(flags & TCL_WINDOW_EVENTS)) {
return;
}
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
XFlush(dispPtr->display);
- numFound = XQLength(dispPtr->display);
-
- /*
- * Transfer events from the X event queue to the Tk event queue.
- */
-
- while (numFound > 0) {
- XNextEvent(dispPtr->display, &event);
- Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
- numFound--;
- }
+ TransferXEventsToTcl(dispPtr->display);
}
}
+
+
/*
*----------------------------------------------------------------------
@@ -273,7 +312,6 @@ DisplayFileProc(clientData, flags)
{
TkDisplay *dispPtr = (TkDisplay *) clientData;
Display *display = dispPtr->display;
- XEvent event;
int numFound;
XFlush(display);
@@ -311,15 +349,7 @@ DisplayFileProc(clientData, flags)
(void) signal(SIGPIPE, oldHandler);
}
- /*
- * Transfer events from the X event queue to the Tk event queue.
- */
-
- while (numFound > 0) {
- XNextEvent(display, &event);
- Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
- numFound--;
- }
+ TransferXEventsToTcl(display);
}
/*
@@ -394,10 +424,10 @@ TkUnixDoOneXEvent(timePtr)
*/
memset((VOID *) readMask, 0, MASK_SIZE*sizeof(fd_mask));
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
XFlush(dispPtr->display);
- if (XQLength(dispPtr->display) > 0) {
+ if (QLength(dispPtr->display) > 0) {
blockTime.tv_sec = 0;
blockTime.tv_usec = 0;
}
@@ -425,12 +455,12 @@ TkUnixDoOneXEvent(timePtr)
* Process any new events on the display connections.
*/
- for (dispPtr = tkDisplayList; dispPtr != NULL;
+ 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) || (XQLength(dispPtr->display) > 0)) {
+ if ((readMask[index] & bit) || (QLength(dispPtr->display) > 0)) {
DisplayFileProc((ClientData)dispPtr, TCL_READABLE);
}
}
@@ -480,19 +510,12 @@ void
TkpSync(display)
Display *display; /* Display to sync. */
{
- int numFound = 0;
- XEvent event;
-
XSync(display, False);
/*
* Transfer events from the X event queue to the Tk event queue.
*/
+ TransferXEventsToTcl(display);
- numFound = XQLength(display);
- while (numFound > 0) {
- XNextEvent(display, &event);
- Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
- numFound--;
- }
}
+
diff --git a/tk/unix/tkUnixFocus.c b/tk/unix/tkUnixFocus.c
index c6d11a7cb6f..51e4b56c243 100644
--- a/tk/unix/tkUnixFocus.c
+++ b/tk/unix/tkUnixFocus.c
@@ -16,7 +16,6 @@
#include "tkPort.h"
#include "tkUnixInt.h"
-extern int tclFocusDebug;
/*
*----------------------------------------------------------------------
@@ -147,3 +146,4 @@ TkpChangeFocus(winPtr, force)
XFlush(dispPtr->display);
return serial;
}
+
diff --git a/tk/unix/tkUnixFont.c b/tk/unix/tkUnixFont.c
index 7f48de28ea3..f9e4229f5c9 100644
--- a/tk/unix/tkUnixFont.c
+++ b/tk/unix/tkUnixFont.c
@@ -4,7 +4,7 @@
* Contains the Unix implementation of the platform-independant
* font package interface.
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * 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.
@@ -12,88 +12,379 @@
* RCS: @(#) $Id$
*/
-#include "tkPort.h"
-#include "tkInt.h"
#include "tkUnixInt.h"
-
#include "tkFont.h"
-#ifndef ABS
-#define ABS(n) (((n) < 0) ? -(n) : (n))
-#endif
+/*
+ * The 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.
+ * 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. */
- Display *display; /* The display to which font belongs. */
- XFontStruct *fontStructPtr; /* X information about font. */
- char types[256]; /* Array giving types of all characters in
- * the font, used when displaying control
- * characters. See below for definition. */
- int widths[256]; /* Array giving widths of all possible
- * characters in the font. */
+ 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 for simulating a native
- * underlined font). */
+ * underline bar (used when drawing underlined
+ * font) (pixels). */
int barHeight; /* Height of underline or overstrike bar
- * (used for simulating a native underlined or
- * strikeout font). */
+ * (used when drawing underlined or strikeout
+ * font) (pixels). */
} UnixFont;
/*
- * Possible values for entries in the "types" field in a UnixFont structure,
- * which classifies the types of all characters in the given font. This
- * information is used when measuring and displaying characters.
- *
- * NORMAL: Standard character.
- * REPLACE: This character doesn't print: instead of
- * displaying character, display a replacement
- * sequence like "\n" (for those characters where
- * ANSI C defines such a sequence) or a sequence
- * of the form "\xdd" where dd is the hex equivalent
- * of the character.
- * SKIP: Don't display anything for this character. This
- * is only used where the font doesn't contain
- * all the characters needed to generate
- * replacement sequences.
- */
-
-#define NORMAL 0
-#define REPLACE 1
-#define SKIP 2
+ * 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;
/*
- * Characters used when displaying control sequences.
+ * 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;
-static char hexChars[] = "0123456789abcdefxtnvr\\";
+/*
+ * The set of builtin encoding alises to convert the XLFD names for the
+ * encodings into the names expected by the Tcl encoding package.
+ */
+
+static EncodingAlias encodingAliases[] = {
+ {"gb2312", "gb2312*"},
+ {"big5", "big5*"},
+ {"cns11643-1", "cns11643*-1"},
+ {"cns11643-1", "cns11643*.1-0"},
+ {"cns11643-2", "cns11643*-2"},
+ {"cns11643-2", "cns11643*.2-0"},
+ {"jis0201", "jisx0202*"},
+ {"jis0208", "jisc6226*"},
+ {"jis0208", "jisx0208*"},
+ {"jis0212", "jisx0212*"},
+ {"tis620", "tis620*"},
+ {"ksc5601", "ksc5601*"},
+ {"dingbats", "*dingbats"},
+ {NULL, NULL}
+};
/*
- * The following table maps some control characters to sequences like '\n'
- * rather than '\x10'. A zero entry in the table means no such mapping
- * exists, and the table only maps characters less than 0x10.
+ * Procedures used only in this file.
*/
-static char mapChars[] = {
- 0, 0, 0, 0, 0, 0, 0,
- 'a', 'b', 't', 'n', 'v', 'f', 'r',
- 0
-};
+static FontFamily * AllocFontFamily _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, int base));
+static SubFont * CanUseFallback _ANSI_ARGS_((UnixFont *fontPtr,
+ char *fallbackName, int ch));
+static SubFont * CanUseFallbackWithAliases _ANSI_ARGS_((
+ UnixFont *fontPtr, char *fallbackName,
+ int ch, Tcl_DString *nameTriedPtr));
+static int ControlUtfProc _ANSI_ARGS_((ClientData clientData,
+ CONST char *src, int srcLen, int flags,
+ Tcl_EncodingState *statePtr, char *dst,
+ int dstLen, int *srcReadPtr, int *dstWrotePtr,
+ int *dstCharsPtr));
+static XFontStruct * CreateClosestFont _ANSI_ARGS_((Tk_Window tkwin,
+ CONST TkFontAttributes *faPtr,
+ CONST TkXLFDAttributes *xaPtr));
+static SubFont * FindSubFontForChar _ANSI_ARGS_((UnixFont *fontPtr,
+ int ch));
+static void FontMapInsert _ANSI_ARGS_((SubFont *subFontPtr,
+ int ch));
+static void FontMapLoadPage _ANSI_ARGS_((SubFont *subFontPtr,
+ int row));
+static int FontMapLookup _ANSI_ARGS_((SubFont *subFontPtr,
+ int ch));
+static void FreeFontFamily _ANSI_ARGS_((FontFamily *afPtr));
+static CONST char * GetEncodingAlias _ANSI_ARGS_((CONST char *name));
+static int GetFontAttributes _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, FontAttributes *faPtr));
+static XFontStruct * GetScreenFont _ANSI_ARGS_((Display *display,
+ FontAttributes *wantPtr, char **nameList,
+ int bestIdx[], unsigned int bestScore[]));
+static XFontStruct * GetSystemFont _ANSI_ARGS_((Display *display));
+static int IdentifySymbolEncodings _ANSI_ARGS_((
+ FontAttributes *faPtr));
+static void InitFont _ANSI_ARGS_((Tk_Window tkwin,
+ XFontStruct *fontStructPtr, UnixFont *fontPtr));
+static void InitSubFont _ANSI_ARGS_((Display *display,
+ XFontStruct *fontStructPtr, int base,
+ SubFont *subFontPtr));
+static char ** ListFonts _ANSI_ARGS_((Display *display,
+ CONST char *faceName, int *numNamesPtr));
+static char ** ListFontOrAlias _ANSI_ARGS_((Display *display,
+ CONST char *faceName, int *numNamesPtr));
+static unsigned int RankAttributes _ANSI_ARGS_((FontAttributes *wantPtr,
+ FontAttributes *gotPtr));
+static void ReleaseFont _ANSI_ARGS_((UnixFont *fontPtr));
+static void ReleaseSubFont _ANSI_ARGS_((Display *display,
+ SubFont *subFontPtr));
+static int SeenName _ANSI_ARGS_((CONST char *name,
+ Tcl_DString *dsPtr));
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TkpFontPkgInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures that are used by the
+ * platform-dependent code on a per application basis.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
-static UnixFont * AllocFont _ANSI_ARGS_((TkFont *tkFontPtr,
- Tk_Window tkwin, XFontStruct *fontStructPtr,
- CONST char *fontName));
-static void DrawChars _ANSI_ARGS_((Display *display,
- Drawable drawable, GC gc, UnixFont *fontPtr,
- CONST char *source, int numChars, int x,
- int y));
-static int GetControlCharSubst _ANSI_ARGS_((int c, char buf[4]));
+void
+TkpFontPkgInit(mainPtr)
+ TkMainInfo *mainPtr; /* The application being created. */
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ Tcl_EncodingType type;
+ SubFont dummy;
+ int i;
+
+ if (tsdPtr->controlFamily.encoding == NULL) {
+ type.encodingName = "X11ControlChars";
+ type.toUtfProc = ControlUtfProc;
+ type.fromUtfProc = ControlUtfProc;
+ type.freeProc = NULL;
+ type.clientData = NULL;
+ type.nullSize = 0;
+
+ tsdPtr->controlFamily.refCount = 2;
+ tsdPtr->controlFamily.encoding = Tcl_CreateEncoding(&type);
+ tsdPtr->controlFamily.isTwoByteFont = 0;
+
+ dummy.familyPtr = &tsdPtr->controlFamily;
+ dummy.fontMap = tsdPtr->controlFamily.fontMap;
+ for (i = 0x00; i < 0x20; i++) {
+ FontMapInsert(&dummy, i);
+ FontMapInsert(&dummy, i + 0x80);
+ }
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ControlUtfProc --
+ *
+ * Convert from UTF-8 into the ASCII expansion of a control
+ * character.
+ *
+ * Results:
+ * Returns TCL_OK if conversion was successful.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+static int
+ControlUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+ srcReadPtr, dstWrotePtr, dstCharsPtr)
+ ClientData clientData; /* Not used. */
+ CONST char *src; /* Source string in UTF-8. */
+ int srcLen; /* Source string length in bytes. */
+ int flags; /* Conversion control flags. */
+ Tcl_EncodingState *statePtr;/* Place for conversion routine to store
+ * state information used during a piecewise
+ * conversion. Contents of statePtr are
+ * initialized and/or reset by conversion
+ * routine under control of flags argument. */
+ char *dst; /* Output buffer in which converted string
+ * is stored. */
+ int dstLen; /* The maximum length of output buffer in
+ * bytes. */
+ int *srcReadPtr; /* Filled with the number of bytes from the
+ * source string that were converted. This
+ * may be less than the original source length
+ * if there was a problem converting some
+ * source characters. */
+ int *dstWrotePtr; /* Filled with the number of bytes that were
+ * stored in the output buffer as a result of
+ * the conversion. */
+ int *dstCharsPtr; /* Filled with the number of characters that
+ * correspond to the bytes stored in the
+ * output buffer. */
+{
+ CONST char *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;
+}
/*
*---------------------------------------------------------------------------
@@ -116,24 +407,81 @@ static int GetControlCharSubst _ANSI_ARGS_((int c, char buf[4]));
* the contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
- * None.
+ * 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) {
- return 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 *) AllocFont(NULL, tkwin, fontStructPtr, name);
+ return (TkFont *) fontPtr;
}
/*
@@ -160,7 +508,7 @@ TkpGetNativeFont(tkwin, name)
* the contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
- * None.
+ * Memory allocated.
*
*---------------------------------------------------------------------------
*/
@@ -173,249 +521,29 @@ TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
* 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. */
+ CONST TkFontAttributes *faPtr;
+ /* Set of attributes to match. */
{
- int numNames, score, i, scaleable, pixelsize, xaPixelsize;
- int bestIdx, bestScore, bestScaleableIdx, bestScaleableScore;
- TkXLFDAttributes xa;
- char buf[256];
UnixFont *fontPtr;
- char **nameList;
+ TkXLFDAttributes xa;
XFontStruct *fontStructPtr;
- CONST char *fmt, *family;
- double d;
-
- family = faPtr->family;
- if (family == NULL) {
- family = "*";
- }
-
- pixelsize = -faPtr->pointsize;
- if (pixelsize < 0) {
- d = -pixelsize * 25.4 / 72;
- d *= WidthOfScreen(Tk_Screen(tkwin));
- d /= WidthMMOfScreen(Tk_Screen(tkwin));
- d += 0.5;
- pixelsize = (int) d;
- }
-
- /*
- * Replace the standard Windows and Mac family names with the names that
- * X likes.
- */
-
- if ((strcasecmp("Times New Roman", family) == 0)
- || (strcasecmp("New York", family) == 0)) {
- family = "Times";
- } else if ((strcasecmp("Courier New", family) == 0)
- || (strcasecmp("Monaco", family) == 0)) {
- family = "Courier";
- } else if ((strcasecmp("Arial", family) == 0)
- || (strcasecmp("Geneva", family) == 0)) {
- family = "Helvetica";
- }
-
- /*
- * First try for the Q&D exact match.
- */
-
-#if 0
- sprintf(buf, "-*-%.200s-%s-%c-normal-*-*-%d-*-*-*-*-iso8859-1", family,
- ((faPtr->weight > TK_FW_NORMAL) ? "bold" : "medium"),
- ((faPtr->slant == TK_FS_ROMAN) ? 'r' :
- (faPtr->slant == TK_FS_ITALIC) ? 'i' : 'o'),
- faPtr->pointsize * 10);
- fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf);
-#else
- fontStructPtr = NULL;
-#endif
-
- if (fontStructPtr != NULL) {
- goto end;
- }
- /*
- * Couldn't find exact match. Now fall back to other available
- * physical fonts.
- */
- fmt = "-*-%.240s-*-*-*-*-*-*-*-*-*-*-*-*";
- sprintf(buf, fmt, family);
- nameList = XListFonts(Tk_Display(tkwin), buf, 10000, &numNames);
- if (numNames == 0) {
- /*
- * Try getting some system font.
- */
-
- sprintf(buf, fmt, "fixed");
- nameList = XListFonts(Tk_Display(tkwin), buf, 10000, &numNames);
- if (numNames == 0) {
- getsystem:
- fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), "fixed");
- if (fontStructPtr == NULL) {
- fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), "*");
- if (fontStructPtr == NULL) {
- panic("TkpGetFontFromAttributes: cannot get any font");
- }
- }
- goto end;
- }
- }
-
- /*
- * Inspect each of the XLFDs and pick the one that most closely
- * matches the desired attributes.
- */
-
- bestIdx = 0;
- bestScore = INT_MAX;
- bestScaleableIdx = 0;
- bestScaleableScore = INT_MAX;
-
- for (i = 0; i < numNames; i++) {
- score = 0;
- scaleable = 0;
- if (TkParseXLFD(nameList[i], &xa) != TCL_OK) {
- continue;
- }
- xaPixelsize = -xa.fa.pointsize;
-
- /*
- * Since most people used to use -adobe-* in their XLFDs,
- * preserve the preference for "adobe" foundry. Otherwise
- * some applications looks may change slightly if another foundry
- * is chosen.
- */
-
- if (strcasecmp(xa.foundry, "adobe") != 0) {
- score += 3000;
- }
- if (xa.fa.pointsize == 0) {
- /*
- * A scaleable font is almost always acceptable, but the
- * corresponding bitmapped font would be better.
- */
-
- score += 10;
- scaleable = 1;
- } else {
- /*
- * A font that is too small is better than one that is too
- * big.
- */
-
- if (xaPixelsize > pixelsize) {
- score += (xaPixelsize - pixelsize) * 120;
- } else {
- score += (pixelsize - xaPixelsize) * 100;
- }
- }
-
- score += ABS(xa.fa.weight - faPtr->weight) * 30;
- score += ABS(xa.fa.slant - faPtr->slant) * 25;
- if (xa.slant == TK_FS_OBLIQUE) {
- /*
- * Italic fonts are preferred over oblique. */
-
- score += 4;
- }
-
- if (xa.setwidth != TK_SW_NORMAL) {
- /*
- * The normal setwidth is highly preferred.
- */
- score += 2000;
- }
- if (xa.charset == TK_CS_OTHER) {
- /*
- * The standard character set is highly preferred over
- * foreign languages charsets (because we don't support
- * other languages yet).
- */
- score += 11000;
- }
- if ((xa.charset == TK_CS_NORMAL) && (xa.encoding != 1)) {
- /*
- * The '1' encoding for the characters above 0x7f is highly
- * preferred over the other encodings.
- */
- score += 8000;
- }
-
- if (scaleable) {
- if (score < bestScaleableScore) {
- bestScaleableIdx = i;
- bestScaleableScore = score;
- }
- } else {
- if (score < bestScore) {
- bestIdx = i;
- bestScore = score;
- }
- }
- if (score == 0) {
- break;
- }
- }
-
- /*
- * Now we know which is the closest matching scaleable font and the
- * closest matching bitmapped font. If the scaleable font was a
- * better match, try getting the scaleable font; however, if the
- * scalable font was not actually available in the desired
- * pointsize, fall back to the closest bitmapped font.
- */
+ TkInitXLFDAttributes(&xa);
+ fontStructPtr = CreateClosestFont(tkwin, faPtr, &xa);
- fontStructPtr = NULL;
- if (bestScaleableScore < bestScore) {
- char *str, *rest;
-
- /*
- * Fill in the desired pointsize info for this font.
- */
-
- tryscale:
- str = nameList[bestScaleableIdx];
- for (i = 0; i < XLFD_PIXEL_SIZE - 1; i++) {
- str = strchr(str + 1, '-');
- }
- rest = str;
- for (i = XLFD_PIXEL_SIZE - 1; i < XLFD_REGISTRY; i++) {
- rest = strchr(rest + 1, '-');
- }
- *str = '\0';
- sprintf(buf, "%.240s-*-%d-*-*-*-*-*%s", nameList[bestScaleableIdx],
- pixelsize, rest);
- *str = '-';
- fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf);
- bestScaleableScore = INT_MAX;
- }
- if (fontStructPtr == NULL) {
- strcpy(buf, nameList[bestIdx]);
- fontStructPtr = XLoadQueryFont(Tk_Display(tkwin), buf);
- if (fontStructPtr == NULL) {
- /*
- * This shouldn't happen because the font name is one of the
- * names that X gave us to use, but it does anyhow.
- */
-
- if (bestScaleableScore < INT_MAX) {
- goto tryscale;
- } else {
- XFreeFontNames(nameList);
- goto getsystem;
- }
- }
+ fontPtr = (UnixFont *) tkFontPtr;
+ if (fontPtr == NULL) {
+ fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
+ } else {
+ ReleaseFont(fontPtr);
}
- XFreeFontNames(nameList);
+ InitFont(tkwin, fontStructPtr, fontPtr);
- end:
- fontPtr = AllocFont(tkFontPtr, tkwin, fontStructPtr, buf);
- fontPtr->font.fa.underline = faPtr->underline;
+ fontPtr->font.fa.underline = faPtr->underline;
fontPtr->font.fa.overstrike = faPtr->overstrike;
return (TkFont *) fontPtr;
}
-
/*
*---------------------------------------------------------------------------
@@ -443,9 +571,7 @@ TkpDeleteFont(tkFontPtr)
UnixFont *fontPtr;
fontPtr = (UnixFont *) tkFontPtr;
-
- XFreeFont(fontPtr->display, fontPtr->fontStructPtr);
- ckfree((char *) fontPtr);
+ ReleaseFont(fontPtr);
}
/*
@@ -457,7 +583,7 @@ TkpDeleteFont(tkFontPtr)
* on the display of the given window.
*
* Results:
- * interp->result is modified to hold a list of all the available
+ * Modifies interp's result object to hold a list of all the available
* font families.
*
* Side effects:
@@ -465,52 +591,80 @@ TkpDeleteFont(tkFontPtr)
*
*---------------------------------------------------------------------------
*/
-
+
void
TkpGetFontFamilies(interp, tkwin)
- Tcl_Interp *interp;
- Tk_Window tkwin;
+ Tcl_Interp *interp; /* Interp to hold result. */
+ Tk_Window tkwin; /* For display to query. */
{
int i, new, numNames;
- char *family, *end, *p;
+ char *family;
Tcl_HashTable familyTable;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
char **nameList;
+ Tcl_Obj *resultPtr, *strPtr;
- Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);
+ resultPtr = Tcl_GetObjResult(interp);
- nameList = XListFonts(Tk_Display(tkwin), "*", 10000, &numNames);
+ Tcl_InitHashTable(&familyTable, TCL_STRING_KEYS);
+ nameList = ListFonts(Tk_Display(tkwin), "*", &numNames);
for (i = 0; i < numNames; i++) {
- if (nameList[i][0] != '-') {
- continue;
- }
- family = strchr(nameList[i] + 1, '-');
- if (family == NULL) {
- continue;
- }
- family++;
- end = strchr(family, '-');
- if (end == NULL) {
- continue;
- }
- *end = '\0';
- for (p = family; *p != '\0'; p++) {
- if (isupper(UCHAR(*p))) {
- *p = tolower(UCHAR(*p));
- }
- }
+ 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) {
- Tcl_AppendElement(interp, Tcl_GetHashKey(&familyTable, hPtr));
+ strPtr = Tcl_NewStringObj(Tcl_GetHashKey(&familyTable, hPtr), -1);
+ Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
hPtr = Tcl_NextHashEntry(&search);
}
Tcl_DeleteHashTable(&familyTable);
- XFreeFontNames(nameList);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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);
+ }
}
/*
@@ -524,7 +678,7 @@ TkpGetFontFamilies(interp, tkwin)
* the characters.
*
* Results:
- * The return value is the number of characters from source that
+ * 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.
@@ -534,18 +688,19 @@ TkpGetFontFamilies(interp, tkwin)
*
*---------------------------------------------------------------------------
*/
+
int
-Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
+Tk_MeasureChars(tkfont, source, numBytes, maxLength, flags, lengthPtr)
Tk_Font tkfont; /* Font in which characters will be drawn. */
- CONST char *source; /* Characters to be displayed. Need not be
+ CONST char *source; /* UTF-8 string to be displayed. Need not be
* '\0' terminated. */
- int numChars; /* Maximum number of characters to consider
+ 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
+ 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
@@ -558,99 +713,179 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
* terminating character. */
{
UnixFont *fontPtr;
- CONST char *p; /* Current character. */
- CONST char *term; /* Pointer to most recent character that
- * may legally be a terminating character. */
- int termX; /* X-position just after term. */
- int curX; /* X-position corresponding to p. */
- int newX; /* X-position corresponding to p+1. */
- int c, sawNonSpace;
+ SubFont *lastSubFontPtr;
+ int curX, curByte;
- fontPtr = (UnixFont *) tkfont;
+ /*
+ * 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.
+ */
- if (numChars == 0) {
- *lengthPtr = 0;
- return 0;
- }
+ fontPtr = (UnixFont *) tkfont;
- if (maxLength <= 0) {
- maxLength = INT_MAX;
- }
+ lastSubFontPtr = &fontPtr->subFontArray[0];
- newX = curX = termX = 0;
- p = term = source;
- sawNonSpace = !isspace(UCHAR(*p));
+ 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;
- /*
- * Scan the input string one character at a time, calculating width.
- */
+ /*
+ * 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.
+ */
- for (c = UCHAR(*p); ; ) {
- newX += fontPtr->widths[c];
- if (newX > maxLength) {
- break;
+ 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;
}
- curX = newX;
- numChars--;
- p++;
- if (numChars == 0) {
- term = p;
- termX = curX;
- break;
+ 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.
+ */
- c = UCHAR(*p);
- if (isspace(c)) {
- if (sawNonSpace) {
- term = p;
+ 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;
- sawNonSpace = 0;
+ break;
}
- } 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.
- */
+ next += Tcl_UtfToUniChar(next, &ch);
+ if ((ch < 256) && isspace(ch)) {
+ if (sawNonSpace) {
+ term = p;
+ termX = curX;
+ sawNonSpace = 0;
+ }
+ } else {
+ sawNonSpace = 1;
+ }
+ }
- if ((flags & TK_PARTIAL_OK) && (numChars > 0) && (curX < maxLength)) {
/*
- * Include the first character that didn't quite fit in the desired
- * span. The width returned will include the width of that extra
- * character.
+ * P points to the first character that doesn't fit in the desired
+ * span. Use the flags to figure out what to return.
*/
- numChars--;
- curX = newX;
- p++;
- }
- if ((flags & TK_AT_LEAST_ONE) && (term == source) && (numChars > 0)) {
- term = p;
- termX = curX;
- if (term == source) {
- term++;
- termX = newX;
+ 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);
}
- } else if ((numChars == 0) || !(flags & TK_WHOLE_WORDS)) {
- term = p;
- termX = curX;
+ 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 = termX;
- return term-source;
+ *lengthPtr = curX;
+ return curByte;
}
/*
*---------------------------------------------------------------------------
*
- * Tk_DrawChars, DrawChars --
+ * Tk_DrawChars --
*
* Draw a string of characters on the screen. Tk_DrawChars()
- * expands control characters that occur in the string to \X or
- * \xXX sequences. DrawChars() just draws the strings.
+ * expands control characters that occur in the string to
+ * \xNN sequences.
*
* Results:
* None.
@@ -662,255 +897,359 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
*/
void
-Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
+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; /* Characters to be displayed. Need not be
+ 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 numChars; /* Number of characters in string. */
+ int numBytes; /* Number of bytes in string. */
int x, y; /* Coordinates at which to place origin of
* string when drawing. */
{
UnixFont *fontPtr;
- CONST char *p;
- int i, type;
- char buf[4];
+ SubFont *thisSubFontPtr, *lastSubFontPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ int xStart, needWidth;
+ Tcl_UniChar ch;
+ FontFamily *familyPtr;
fontPtr = (UnixFont *) tkfont;
-
- p = source;
- for (i = 0; i < numChars; i++) {
- type = fontPtr->types[UCHAR(*p)];
- if (type != NORMAL) {
- DrawChars(display, drawable, gc, fontPtr, source, p - source, x, y);
- x += XTextWidth(fontPtr->fontStructPtr, source, p - source);
- if (type == REPLACE) {
- DrawChars(display, drawable, gc, fontPtr, buf,
- GetControlCharSubst(UCHAR(*p), buf), x, y);
- x += fontPtr->widths[UCHAR(*p)];
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+
+ xStart = x;
+
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ if (familyPtr->isTwoByteFont) {
+ XDrawString16(display, drawable, gc, x, y,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+
+ x += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) / 2);
+ } else {
+ XDrawString(display, drawable, gc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ x += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ Tcl_DStringFree(&runString);
}
- source = p + 1;
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ XSetFont(display, gc, lastSubFontPtr->fontStructPtr->fid);
}
- p++;
+ p = next;
}
- DrawChars(display, drawable, gc, fontPtr, source, p - source, x, y);
-}
-
-static void
-DrawChars(display, drawable, gc, fontPtr, source, numChars, x, y)
- Display *display; /* Display on which to draw. */
- Drawable drawable; /* Window or pixmap in which to draw. */
- GC gc; /* Graphics context for drawing characters. */
- UnixFont *fontPtr; /* Font in which characters will be drawn;
- * must be the same as font used in GC. */
- CONST char *source; /* Characters to be displayed. Need not be
- * '\0' terminated. All Tk meta-characters
- * (tabs, control characters, and newlines)
- * should be stripped out of the string that
- * is passed to this function. If they are
- * not stripped out, they will be displayed as
- * regular printing characters. */
- int numChars; /* Number of characters in string. */
- int x, y; /* Coordinates at which to place origin of
- * string when drawing. */
-{
- /*
- * Perform a quick sanity check to ensure we won't overflow the X
- * coordinate space.
- */
-
- if ((x + (fontPtr->fontStructPtr->max_bounds.width * numChars) > 0x7fff)) {
- int length;
-
- /*
- * The string we are being asked to draw is too big and would overflow
- * the X coordinate space. Unfortunatley X servers aren't too bright
- * and so they won't deal with this case cleanly. We need to truncate
- * the string before sending it to X.
- */
-
- numChars = Tk_MeasureChars((Tk_Font) fontPtr, source, numChars,
- 0x7fff - x, 0, &length);
+ needWidth = fontPtr->font.fa.underline + fontPtr->font.fa.overstrike;
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ if (familyPtr->isTwoByteFont) {
+ XDrawString16(display, drawable, gc, x, y,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> 1);
+ if (needWidth) {
+ x += XTextWidth16(lastSubFontPtr->fontStructPtr,
+ (XChar2b *) Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> 1);
+ }
+ } else {
+ XDrawString(display, drawable, gc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ if (needWidth) {
+ x += XTextWidth(lastSubFontPtr->fontStructPtr,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString));
+ }
+ }
+ Tcl_DStringFree(&runString);
}
- XDrawString(display, drawable, gc, x, y, source, numChars);
+ if (lastSubFontPtr != &fontPtr->subFontArray[0]) {
+ XSetFont(display, gc, fontPtr->subFontArray[0].fontStructPtr->fid);
+ }
if (fontPtr->font.fa.underline != 0) {
- XFillRectangle(display, drawable, gc, x,
+ XFillRectangle(display, drawable, gc, xStart,
y + fontPtr->underlinePos,
- (unsigned) XTextWidth(fontPtr->fontStructPtr, source, numChars),
- (unsigned) fontPtr->barHeight);
+ (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, x, y,
- (unsigned) XTextWidth(fontPtr->fontStructPtr, source, numChars),
- (unsigned) fontPtr->barHeight);
+ XFillRectangle(display, drawable, gc, xStart, y,
+ (unsigned) (x - xStart), (unsigned) fontPtr->barHeight);
}
}
/*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * AllocFont --
+ * CreateClosestFont --
*
* Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
- * Allocates and intializes the memory for a new TkFont that
- * wraps the platform-specific data.
+ * 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:
- * Returns pointer to newly constructed TkFont.
- *
- * The caller is responsible for initializing the fields of the
- * TkFont that are used exclusively by the generic TkFont code, and
- * for releasing those fields before calling TkpDeleteFont().
+ * 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:
- * Memory allocated.
+ * None.
*
- *---------------------------------------------------------------------------
- */
+ *-------------------------------------------------------------------------
+ */
-static UnixFont *
-AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName)
- TkFont *tkFontPtr; /* If non-NULL, store the information in
- * this existing TkFont structure, rather than
- * allocating a new structure to hold the
- * font; the existing contents of the font
- * will be released. If NULL, a new TkFont
- * structure is allocated. */
+static XFontStruct *
+CreateClosestFont(tkwin, faPtr, xaPtr)
Tk_Window tkwin; /* For display where font will be used. */
- XFontStruct *fontStructPtr; /* X information about font. */
- CONST char *fontName; /* The string passed to XLoadQueryFont() to
- * construct the fontStructPtr. */
+ CONST TkFontAttributes *faPtr;
+ /* Set of generic attributes to match. */
+ CONST TkXLFDAttributes *xaPtr;
+ /* Set of X-specific attributes to match. */
{
- UnixFont *fontPtr;
- unsigned long value;
- int i, width, firstChar, lastChar, n, replaceOK;
- char *name, *p;
- char buf[4];
- TkXLFDAttributes xa;
- double d;
-
- if (tkFontPtr != NULL) {
- fontPtr = (UnixFont *) tkFontPtr;
- XFreeFont(fontPtr->display, fontPtr->fontStructPtr);
- } else {
- fontPtr = (UnixFont *) ckalloc(sizeof(UnixFont));
+ 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);
/*
- * Encapsulate the generic stuff in the TkFont.
+ * 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
*/
- fontPtr->font.fid = fontStructPtr->fid;
-
- if (XGetFontProperty(fontStructPtr, XA_FONT, &value) && (value != 0)) {
- name = Tk_GetAtomName(tkwin, (Atom) value);
- TkInitFontAttributes(&xa.fa);
- if (TkParseXLFD(name, &xa) == TCL_OK) {
- goto ok;
+ 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);
}
}
- TkInitFontAttributes(&xa.fa);
- if (TkParseXLFD(fontName, &xa) != TCL_OK) {
- TkInitFontAttributes(&fontPtr->font.fa);
- fontPtr->font.fa.family = Tk_GetUid(fontName);
- } else {
- ok:
- fontPtr->font.fa = xa.fa;
+ 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;
+ }
}
- if (fontPtr->font.fa.pointsize < 0) {
- d = -fontPtr->font.fa.pointsize * 72 / 25.4;
- d *= WidthMMOfScreen(Tk_Screen(tkwin));
- d /= WidthOfScreen(Tk_Screen(tkwin));
- d += 0.5;
- fontPtr->font.fa.pointsize = (int) d;
+ fontStructPtr = GetScreenFont(display, &want, nameList, bestIdx, bestScore);
+ XFreeFontNames(nameList);
+
+ if (fontStructPtr == NULL) {
+ return GetSystemFont(display);
}
-
- fontPtr->font.fm.ascent = fontStructPtr->ascent;
- fontPtr->font.fm.descent = fontStructPtr->descent;
- fontPtr->font.fm.maxWidth = fontStructPtr->max_bounds.width;
- fontPtr->font.fm.fixed = 1;
- fontPtr->display = Tk_Display(tkwin);
- fontPtr->fontStructPtr = fontStructPtr;
+ 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;
/*
- * Classify the characters.
+ * Get all font attributes and metrics.
*/
-
- firstChar = fontStructPtr->min_char_or_byte2;
- lastChar = fontStructPtr->max_char_or_byte2;
- for (i = 0; i < 256; i++) {
- if ((i == 0177) || (i < firstChar) || (i > lastChar)) {
- fontPtr->types[i] = REPLACE;
- } else {
- fontPtr->types[i] = NORMAL;
+
+ 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;
+ }
+ }
}
}
- /*
- * Compute the widths for all the normal characters. Any other
- * characters are given an initial width of 0. Also, this determines
- * if this is a fixed or variable width font, by comparing the widths
- * of all the normal characters.
- */
-
- width = 0;
+ 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 (fontPtr->types[i] != NORMAL) {
+ 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 - firstChar].width;
+ n = fontStructPtr->per_char[i - minLo].width;
}
fontPtr->widths[i] = n;
- if (n != 0) {
- if (width == 0) {
- width = n;
- } else if (width != n) {
- fontPtr->font.fm.fixed = 0;
- }
- }
- }
-
- /*
- * Compute the widths of the characters that should be replaced with
- * control character expansions. If the appropriate chars are not
- * available in this font, then control character expansions will not
- * be used; control chars will be invisible & zero-width.
- */
-
- replaceOK = 1;
- for (p = hexChars; *p != '\0'; p++) {
- if ((UCHAR(*p) < firstChar) || (UCHAR(*p) > lastChar)) {
- replaceOK = 0;
- break;
- }
- }
- for (i = 0; i < 256; i++) {
- if (fontPtr->types[i] == REPLACE) {
- if (replaceOK) {
- n = GetControlCharSubst(i, buf);
- for ( ; --n >= 0; ) {
- fontPtr->widths[i] += fontPtr->widths[UCHAR(buf[n])];
- }
- } else {
- fontPtr->types[i] = SKIP;
- }
- }
}
+
if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_POSITION, &value)) {
fontPtr->underlinePos = value;
@@ -924,9 +1263,6 @@ AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName)
}
fontPtr->barHeight = 0;
if (XGetFontProperty(fontStructPtr, XA_UNDERLINE_THICKNESS, &value)) {
- /*
- * Sometimes this is 0 even though it shouldn't be.
- */
fontPtr->barHeight = value;
}
if (fontPtr->barHeight == 0) {
@@ -955,23 +1291,627 @@ AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName)
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.
+ *
+ *-------------------------------------------------------------------------
+ */
- return fontPtr;
+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);
+}
+
+/*
+ *-------------------------------------------------------------------------
*
- * GetControlCharSubst --
+ * AllocFontFamily --
*
- * When displaying text in a widget, a backslashed escape sequence
- * is substituted for control characters that occur in the text.
- * Given a control character, fill in a buffer with the replacement
- * string that should be displayed.
+ * 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:
- * The return value is the length of the substitute string. buf is
- * filled with the substitute string; it is not '\0' terminated.
+ * A pointer to a FontFamily. The reference count in the FontFamily
+ * is automatically incremented. When the SubFont is released, the
+ * reference count is decremented. When no SubFont is using this
+ * FontFamily, it may be deleted.
+ *
+ * Side effects:
+ * A new FontFamily structure will be allocated if this font family
+ * has not been seen. TrueType character existence metrics are
+ * loaded into the FontFamily structure.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static FontFamily *
+AllocFontFamily(display, fontStructPtr, base)
+ Display *display; /* Display in which font will be used. */
+ XFontStruct *fontStructPtr; /* Screen font whose FontFamily is to be
+ * returned. */
+ int base; /* Non-zero if this font family is to be
+ * used in the base font of a font object. */
+{
+ FontFamily *familyPtr;
+ FontAttributes fa;
+ Tcl_Encoding encoding;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ GetFontAttributes(display, fontStructPtr, &fa);
+ encoding = Tcl_GetEncoding(NULL, GetEncodingAlias(fa.xa.charset));
+
+ familyPtr = tsdPtr->fontFamilyList;
+ for (; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if ((familyPtr->faceName == fa.fa.family)
+ && (familyPtr->foundry == fa.xa.foundry)
+ && (familyPtr->encoding == encoding)) {
+ Tcl_FreeEncoding(encoding);
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
+
+ familyPtr = (FontFamily *) ckalloc(sizeof(FontFamily));
+ memset(familyPtr, 0, sizeof(FontFamily));
+ familyPtr->nextPtr = tsdPtr->fontFamilyList;
+ tsdPtr->fontFamilyList = familyPtr;
+
+ /*
+ * Set key for this FontFamily.
+ */
+
+ familyPtr->foundry = fa.xa.foundry;
+ familyPtr->faceName = fa.fa.family;
+ familyPtr->encoding = encoding;
+
+ /*
+ * An initial refCount of 2 means that FontFamily information will
+ * persist even when the SubFont that loaded the FontFamily is released.
+ * Change it to 1 to cause FontFamilies to be unloaded when not in use.
+ */
+
+ familyPtr->refCount = 2;
+ familyPtr->isTwoByteFont = (fontStructPtr->min_byte1 > 0);
+ return familyPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FreeFontFamily --
+ *
+ * Called to free an FontFamily when the SubFont is finished using
+ * it. Frees the contents of the FontFamily and the memory used by
+ * the FontFamily itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FreeFontFamily(familyPtr)
+ FontFamily *familyPtr; /* The FontFamily to delete. */
+{
+ FontFamily **familyPtrPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ int i;
+
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ Tcl_FreeEncoding(familyPtr->encoding);
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which screen font is necessary to use to
+ * display the given character. If the font object does not have
+ * a screen font that can display the character, another screen font
+ * may be loaded into the font object, following a set of preferred
+ * fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(fontPtr, ch)
+ UnixFont *fontPtr; /* The font object with which the character
+ * will be displayed. */
+ int ch; /* The Unicode character to be displayed. */
+{
+ int i, j, k, numNames;
+ char *faceName, *fallback;
+ char **aliases, **nameList, **anyFallbacks;
+ char ***fontFallbacks;
+ SubFont *subFontPtr;
+ Tcl_DString ds;
+
+ if (FontMapLookup(&fontPtr->subFontArray[0], ch)) {
+ return &fontPtr->subFontArray[0];
+ }
+
+ for (i = 1; i < fontPtr->numSubFonts; i++) {
+ if (FontMapLookup(&fontPtr->subFontArray[i], ch)) {
+ return &fontPtr->subFontArray[i];
+ }
+ }
+
+ if (FontMapLookup(&fontPtr->controlSubFont, ch)) {
+ return &fontPtr->controlSubFont;
+ }
+
+ /*
+ * Keep track of all face names that we check, so we don't check some
+ * name multiple times if it can be reached by multiple paths.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ /*
+ * Are there any other fonts with the same face name as the base
+ * font that could display this character, e.g., if the base font
+ * is adobe:fixed:iso8859-1, we could might be able to use
+ * misc:fixed:iso8859-8 or sony:fixed:jisx0208.1983-0
+ */
+
+ faceName = fontPtr->font.fa.family;
+ if (SeenName(faceName, &ds) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ aliases = TkFontGetAliasList(faceName);
+
+ subFontPtr = NULL;
+ fontFallbacks = TkFontGetFallbacks();
+ for (i = 0; fontFallbacks[i] != NULL; i++) {
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ if (strcasecmp(fallback, faceName) == 0) {
+ /*
+ * If the base font has a fallback...
+ */
+
+ goto tryfallbacks;
+ } else if (aliases != NULL) {
+ /*
+ * Or if an alias for the base font has a fallback...
+ */
+
+ for (k = 0; aliases[k] != NULL; k++) {
+ if (strcasecmp(fallback, aliases[k]) == 0) {
+ goto tryfallbacks;
+ }
+ }
+ }
+ }
+ continue;
+
+ tryfallbacks:
+
+ /*
+ * ...then see if we can use one of the fallbacks, or an
+ * alias for one of the fallbacks.
+ */
+
+ for (j = 0; (fallback = fontFallbacks[i][j]) != NULL; j++) {
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+ }
+
+ /*
+ * See if we can use something from the global fallback list.
+ */
+
+ anyFallbacks = TkFontGetGlobalClass();
+ for (i = 0; (fallback = anyFallbacks[i]) != NULL; i++) {
+ subFontPtr = CanUseFallbackWithAliases(fontPtr, fallback, ch, &ds);
+ if (subFontPtr != NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * Try all face names available in the whole system until we
+ * find one that can be used.
+ */
+
+ nameList = ListFonts(fontPtr->display, "*", &numNames);
+ for (i = 0; i < numNames; i++) {
+ fallback = strchr(nameList[i] + 1, '-') + 1;
+ strchr(fallback, '-')[0] = '\0';
+ if (SeenName(fallback, &ds) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, fallback, ch);
+ if (subFontPtr != NULL) {
+ XFreeFontNames(nameList);
+ goto end;
+ }
+ }
+ }
+ XFreeFontNames(nameList);
+
+ end:
+ Tcl_DStringFree(&ds);
+
+ if (subFontPtr == NULL) {
+ /*
+ * No font can display this character, so it will be displayed as a
+ * control character expansion.
+ */
+
+ subFontPtr = &fontPtr->controlSubFont;
+ FontMapInsert(subFontPtr, ch);
+ }
+ return subFontPtr;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLookup --
+ *
+ * See if the screen font can display the given character.
+ *
+ * Results:
+ * The return value is 0 if the screen font cannot display the
+ * character, non-zero otherwise.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+FontMapLookup(subFontPtr, ch)
+ SubFont *subFontPtr; /* Contains font mapping cache to be queried
+ * and possibly updated. */
+ int ch; /* Character to be tested. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ return (subFontPtr->fontMap[row][bitOffset >> 3] >> (bitOffset & 7)) & 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapInsert --
+ *
+ * Tell the font mapping cache that the given screen font should be
+ * used to display the specified character. This is called when no
+ * font on the system can be be found that can display that
+ * character; we lie to the font and tell it that it can display
+ * the character, otherwise we would end up re-searching the entire
+ * fallback hierarchy every time that character was seen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New pages are added to the font mapping cache whenever the
+ * character belongs to a page that hasn't been seen before.
+ * When a page is loaded, information about all the characters on
+ * that page is stored, not just for the single character in
+ * question.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+FontMapInsert(subFontPtr, ch)
+ SubFont *subFontPtr; /* Contains font mapping cache to be
+ * updated. */
+ int ch; /* Character to be added to cache. */
+{
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated screen font can (1) or cannot (0) display
+ * the characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(subFontPtr, row)
+ SubFont *subFontPtr; /* Contains font mapping cache to be
+ * updated. */
+ int row; /* Index of the page to be loaded into
+ * the cache. */
+{
+ char src[TCL_UTF_MAX], buf[16];
+ int minHi, maxHi, minLo, maxLo, scale, checkLo;
+ int i, end, bitOffset, isTwoByteFont, n;
+ Tcl_Encoding encoding;
+ XFontStruct *fontStructPtr;
+ XCharStruct *widths;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ if (subFontPtr->familyPtr == &tsdPtr->controlFamily) {
+ return;
+ }
+
+ fontStructPtr = subFontPtr->fontStructPtr;
+ encoding = subFontPtr->familyPtr->encoding;
+ isTwoByteFont = subFontPtr->familyPtr->isTwoByteFont;
+
+ widths = fontStructPtr->per_char;
+ minHi = fontStructPtr->min_byte1;
+ maxHi = fontStructPtr->max_byte1;
+ minLo = fontStructPtr->min_char_or_byte2;
+ maxLo = fontStructPtr->max_char_or_byte2;
+ scale = maxLo - minLo + 1;
+ checkLo = minLo;
+
+ if (! isTwoByteFont) {
+ if (minLo < 32) {
+ checkLo = 32;
+ }
+ }
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ int hi, lo;
+
+ if (Tcl_UtfToExternal(NULL, encoding, src, Tcl_UniCharToUtf(i, src),
+ TCL_ENCODING_STOPONERROR, NULL, buf, sizeof(buf), NULL,
+ NULL, NULL) != TCL_OK) {
+ continue;
+ }
+ if (isTwoByteFont) {
+ hi = ((unsigned char *) buf)[0];
+ lo = ((unsigned char *) buf)[1];
+ } else {
+ hi = 0;
+ lo = ((unsigned char *) buf)[0];
+ }
+ if ((hi < minHi) || (hi > maxHi) || (lo < checkLo) || (lo > maxLo)) {
+ continue;
+ }
+ n = (hi - minHi) * scale + lo - minLo;
+ if ((widths == NULL) || ((widths[n].width + widths[n].rbearing) != 0)) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(fontPtr, faceName, ch, nameTriedPtr)
+ UnixFont *fontPtr; /* The font object that will own the new
+ * screen font. */
+ char *faceName; /* Desired face name for new screen font. */
+ int ch; /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr; /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ SubFont *subFontPtr;
+ char **aliases;
+ int i;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
*
* Side effects:
* None.
@@ -980,19 +1920,659 @@ AllocFont(tkFontPtr, tkwin, fontStructPtr, fontName)
*/
static int
-GetControlCharSubst(c, buf)
- int c; /* The control character to be replaced. */
- char buf[4]; /* Buffer that gets replacement string. It
- * only needs to be 4 characters long. */
+SeenName(name, dsPtr)
+ CONST char *name; /* The name to check. */
+ Tcl_DString *dsPtr; /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified screen font has not already been loaded
+ * into the font object, determine if the specified screen
+ * font can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont,
+ * owned by the font object. This SubFont can be used to display
+ * the given character. The SubFont represents the screen font
+ * with the base set of font attributes from the font object, but
+ * using the specified face name. NULL is returned if the font
+ * object already holds a reference to the specified font or if
+ * the specified font doesn't exist or cannot display the given
+ * character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(fontPtr, faceName, ch)
+ UnixFont *fontPtr; /* The font object that will own the new
+ * screen font. */
+ char *faceName; /* Desired face name for new screen font. */
+ int ch; /* The Unicode character that the new
+ * screen font must be able to display. */
{
- buf[0] = '\\';
- if ((c < sizeof(mapChars)) && (mapChars[c] != 0)) {
- buf[1] = mapChars[c];
- return 2;
+ 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 {
- buf[1] = 'x';
- buf[2] = hexChars[(c >> 4) & 0xf];
- buf[3] = hexChars[c & 0xf];
- return 4;
+ 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/tk/unix/tkUnixInit.c b/tk/unix/tkUnixInit.c
index a566f0fba1b..7f3a4b0fe5a 100644
--- a/tk/unix/tkUnixInit.c
+++ b/tk/unix/tkUnixInit.c
@@ -32,7 +32,7 @@
*
* Results:
* Returns a standard Tcl result. Leaves an error message or result
- * in interp->result.
+ * in the interp's result.
*
* Side effects:
* Sets "tk_library" Tcl variable, runs "tk.tcl" script.
@@ -109,9 +109,10 @@ TkpDisplayWarning(msg, title)
{
Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, title, -1);
- Tcl_Write(errChannel, ": ", 2);
- Tcl_Write(errChannel, msg, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteChars(errChannel, title, -1);
+ Tcl_WriteChars(errChannel, ": ", 2);
+ Tcl_WriteChars(errChannel, msg, -1);
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
+
diff --git a/tk/unix/tkUnixInt.h b/tk/unix/tkUnixInt.h
index 00b9d14a978..73becfb17f3 100644
--- a/tk/unix/tkUnixInt.h
+++ b/tk/unix/tkUnixInt.h
@@ -16,17 +16,15 @@
#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.
*/
-
-EXTERN void TkCreateXEventSource _ANSI_ARGS_((void));
-EXTERN TkWindow * TkpGetContainer _ANSI_ARGS_((TkWindow *embeddedPtr));
-EXTERN TkWindow * TkpGetWrapperWindow _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN Window TkUnixContainerId _ANSI_ARGS_((TkWindow *winPtr));
-EXTERN int TkUnixDoOneXEvent _ANSI_ARGS_((Tcl_Time *timePtr));
-EXTERN void TkUnixSetMenubar _ANSI_ARGS_((Tk_Window tkwin,
- Tk_Window menubar));
+#include "tkIntPlatDecls.h"
#endif /* _TKUNIXINT */
+
diff --git a/tk/unix/tkUnixKey.c b/tk/unix/tkUnixKey.c
new file mode 100644
index 00000000000..9c3f7f1d6f0
--- /dev/null
+++ b/tk/unix/tkUnixKey.c
@@ -0,0 +1,355 @@
+/*
+ * 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:
+ */
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetString --
+ *
+ * Retrieve the UTF string associated with a keyboard event.
+ *
+ * Results:
+ * Returns the UTF string.
+ *
+ * Side effects:
+ * Stores the input string in the specified Tcl_DString. Modifies
+ * the internal input state. This routine can only be called
+ * once for a given event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkpGetString(winPtr, eventPtr, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ XEvent *eventPtr; /* X keyboard event. */
+ Tcl_DString *dsPtr; /* Uninitialized or empty string to hold
+ * result. */
+{
+ int len;
+ Tcl_DString buf;
+ Status status;
+
+ /*
+ * Overallocate the dstring to the maximum stack amount.
+ */
+
+ Tcl_DStringInit(&buf);
+ Tcl_DStringSetLength(&buf, TCL_DSTRING_STATIC_SIZE-1);
+
+#ifdef TK_USE_INPUT_METHODS
+ if (winPtr->dispPtr->useInputMethods
+ && (winPtr->inputContext != NULL)
+ && (eventPtr->type == KeyPress)) {
+ len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
+ Tcl_DStringValue(&buf), Tcl_DStringLength(&buf),
+ (KeySym *) NULL, &status);
+ /*
+ * If the buffer wasn't big enough, grow the buffer and try again.
+ */
+
+ if (status == XBufferOverflow) {
+ Tcl_DStringSetLength(&buf, len);
+ len = XmbLookupString(winPtr->inputContext, &eventPtr->xkey,
+ Tcl_DStringValue(&buf), len, (KeySym *) NULL, &status);
+ }
+ if ((status != XLookupChars) && (status != XLookupBoth)) {
+ len = 0;
+ }
+ } else {
+ len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf), (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+ }
+#else /* TK_USE_INPUT_METHODS */
+ len = XLookupString(&eventPtr->xkey, Tcl_DStringValue(&buf),
+ Tcl_DStringLength(&buf), (KeySym *) NULL,
+ (XComposeStatus *) NULL);
+#endif /* TK_USE_INPUT_METHODS */
+ Tcl_DStringSetLength(&buf, len);
+
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buf), len, dsPtr);
+ Tcl_DStringFree(&buf);
+
+ return Tcl_DStringValue(dsPtr);
+}
+
+/*
+ * 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/tk/unix/tkUnixMenu.c b/tk/unix/tkUnixMenu.c
index 1b53d8b61a9..1ee5df86494 100644
--- a/tk/unix/tkUnixMenu.c
+++ b/tk/unix/tkUnixMenu.c
@@ -3,7 +3,7 @@
*
* This module implements the UNIX platform-specific features of menus.
*
- * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * 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.
@@ -178,7 +178,7 @@ TkpDestroyMenuEntry(mEntryPtr)
*
* Results:
* Returns standard TCL result. If TCL_ERROR is returned, then
- * interp->result contains an error message.
+ * the interp's result contains an error message.
*
* Side effects:
* Configuration information get set for mePtr; old resources
@@ -198,11 +198,11 @@ TkpConfigureMenuEntry(mePtr)
* see if the child menu is a help menu.
*/
- if ((mePtr->type == CASCADE_ENTRY) && (mePtr->name != NULL)) {
+ if ((mePtr->type == CASCADE_ENTRY) && (mePtr->namePtr != NULL)) {
TkMenuReferences *menuRefPtr;
- menuRefPtr = TkFindMenuReferences(mePtr->menuPtr->interp,
- mePtr->name);
+ menuRefPtr = TkFindMenuReferencesObj(mePtr->menuPtr->interp,
+ mePtr->namePtr);
if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
SetHelpMenu(menuRefPtr->menuPtr);
}
@@ -321,32 +321,46 @@ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
int *widthPtr; /* The resulting width */
int *heightPtr; /* The resulting height */
{
- if (!mePtr->hideMargin && mePtr->indicatorOn &&
- ((mePtr->type == CHECK_BUTTON_ENTRY)
- || (mePtr->type == RADIO_BUTTON_ENTRY))) {
- if ((mePtr->image != NULL) || (mePtr->bitmap != None)) {
- *widthPtr = (14 * mePtr->height) / 10;
- *heightPtr = mePtr->height;
- if (mePtr->type == CHECK_BUTTON_ENTRY) {
- mePtr->platformEntryData =
- (TkMenuPlatformEntryData) ((65 * mePtr->height) / 100);
+ 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 {
- mePtr->platformEntryData =
- (TkMenuPlatformEntryData) ((75 * mePtr->height) / 100);
- }
- } else {
- *widthPtr = *heightPtr = mePtr->height;
- if (mePtr->type == CHECK_BUTTON_ENTRY) {
- mePtr->platformEntryData = (TkMenuPlatformEntryData)
+ *widthPtr = *heightPtr = mePtr->height;
+ if (mePtr->type == CHECK_BUTTON_ENTRY) {
+ mePtr->platformEntryData = (TkMenuPlatformEntryData)
((80 * mePtr->height) / 100);
- } else {
- mePtr->platformEntryData = (TkMenuPlatformEntryData)
+ } 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 = menuPtr->borderWidth;
+ *widthPtr = borderWidth;
}
}
@@ -379,8 +393,11 @@ GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
*heightPtr = fmPtr->linespace;
if (mePtr->type == CASCADE_ENTRY) {
*widthPtr = 2 * CASCADE_ARROW_WIDTH;
- } else if ((menuPtr->menuType != MENUBAR) && (mePtr->accel != NULL)) {
- *widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength);
+ } else if ((menuPtr->menuType != MENUBAR)
+ && (mePtr->accelPtr != NULL)) {
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+
+ *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
} else {
*widthPtr = 0;
}
@@ -416,8 +433,10 @@ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y,
int width; /* Width of entry rect */
int height; /* Height of entry rect */
{
- if (mePtr->state == tkActiveUid) {
+ if (mePtr->state == ENTRY_ACTIVE) {
int relief;
+ int activeBorderWidth;
+
bgBorder = activeBorder;
if ((menuPtr->menuType == MENUBAR)
@@ -427,9 +446,11 @@ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y,
} else {
relief = TK_RELIEF_RAISED;
}
-
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
- menuPtr->activeBorderWidth, relief);
+ activeBorderWidth, relief);
} else {
Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder, x, y, width, height,
0, TK_RELIEF_FLAT);
@@ -470,6 +491,7 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder,
int drawArrow; /* Whether or not to draw arrow. */
{
XPoint points[3];
+ int borderWidth, activeBorderWidth;
/*
* Draw accelerator or cascade arrow.
@@ -479,9 +501,13 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder,
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 - menuPtr->borderWidth
- - menuPtr->activeBorderWidth - CASCADE_ARROW_WIDTH;
+ 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;
@@ -491,13 +517,15 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder,
DECORATION_BORDER_WIDTH,
(menuPtr->postedCascade == mePtr)
? TK_RELIEF_SUNKEN : TK_RELIEF_RAISED);
- } else if (mePtr->accel != NULL) {
- int left = x + mePtr->labelWidth + menuPtr->activeBorderWidth
+ } 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, mePtr->accel,
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
mePtr->accelLength, left,
(y + (height + fmPtr->ascent - fmPtr->descent) / 2));
}
@@ -535,62 +563,67 @@ DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr,
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;
+ if ((mePtr->type == CHECK_BUTTON_ENTRY) && mePtr->indicatorOn) {
+ int dim, top, left;
+ int activeBorderWidth;
+ Tk_3DBorder border;
dim = (int) mePtr->platformEntryData;
- left = x + menuPtr->activeBorderWidth
- + (mePtr->indicatorSpace - dim)/2;
+ 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;
- Tk_Fill3DRectangle(menuPtr->tkwin, d, menuPtr->border, left, top, dim,
+ 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)) {
+ 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;
+ 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
+ points[0].x = x + (mePtr->indicatorSpace
- (int) mePtr->platformEntryData)/2;
points[0].y = y + (height)/2;
- points[1].x = points[0].x + radius;
- points[1].y = points[0].y + radius;
- points[2].x = points[1].x + radius;
- points[2].y = points[0].y;
- points[3].x = points[1].x;
- points[3].y = points[0].y - radius;
- if (mePtr->entryFlags & ENTRY_SELECTED) {
- XFillPolygon(menuPtr->display, d, indicatorGC, points, 4, Convex,
- CoordModeOrigin);
- } else {
- Tk_Fill3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 4,
+ 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, menuPtr->border, points, 4,
- DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
+ }
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 4,
+ DECORATION_BORDER_WIDTH, TK_RELIEF_SUNKEN);
}
}
@@ -625,18 +658,18 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
int height;
{
XPoint points[2];
- int margin;
+ Tk_3DBorder border;
if (menuPtr->menuType == MENUBAR) {
return;
}
- margin = (fmPtr->ascent + fmPtr->descent)/2;
points[0].x = x;
points[0].y = y + height/2;
points[1].x = width - 1;
points[1].y = points[0].y;
- Tk_Draw3DPolygon(menuPtr->tkwin, d, menuPtr->border, points, 2, 1,
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
TK_RELIEF_RAISED);
}
@@ -658,30 +691,27 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
*/
static void
-DrawMenuEntryLabel(
- menuPtr, /* The menu we are drawing */
- mePtr, /* The entry we are drawing */
- d, /* What we are drawing into */
- gc, /* The gc we are drawing into */
- tkfont, /* The precalculated font */
- fmPtr, /* The precalculated font metrics */
- x, /* left edge */
- y, /* right edge */
- width, /* width of entry */
- height) /* height of entry */
- TkMenu *menuPtr;
- TkMenuEntry *mePtr;
- Drawable d;
- GC gc;
- Tk_Font tkfont;
- CONST Tk_FontMetrics *fmPtr;
- int x, y, width, height;
+DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing. */
+ TkMenuEntry *mePtr; /* The entry we are drawing. */
+ Drawable d; /* What we are drawing into. */
+ GC gc; /* The gc we are drawing into.*/
+ Tk_Font tkfont; /* The precalculated font. */
+ CONST Tk_FontMetrics *fmPtr;/* The precalculated font metrics. */
+ int x; /* Left edge. */
+ int y; /* Top edge. */
+ int width; /* width of entry. */
+ int height; /* height of entry. */
{
int baseline;
int indicatorSpace = mePtr->indicatorSpace;
- int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
+ int activeBorderWidth;
+ int leftEdge;
int imageHeight, imageWidth;
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
if (menuPtr->menuType == MENUBAR) {
leftEdge += 5;
}
@@ -703,27 +733,25 @@ DrawMenuEntryLabel(
imageHeight, d, leftEdge,
(int) (y + (mePtr->height - imageHeight)/2));
}
- } else if (mePtr->bitmap != None) {
+ } else if (mePtr->bitmapPtr != None) {
int width, height;
-
- Tk_SizeOfBitmap(menuPtr->display,
- mePtr->bitmap, &width, &height);
- XCopyPlane(menuPtr->display,
- mePtr->bitmap, d,
- gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
+ 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) {
- Tk_DrawChars(menuPtr->display, d, gc,
- tkfont, mePtr->label, mePtr->labelLength,
- leftEdge, baseline);
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
+ mePtr->labelLength, leftEdge, baseline);
DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
width, height);
}
}
- if (mePtr->state == tkDisabledUid) {
- if (menuPtr->disabledFg == NULL) {
+ 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)
@@ -768,15 +796,24 @@ DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
int height;
{
int indicatorSpace = mePtr->indicatorSpace;
+
if (mePtr->underline >= 0) {
- int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
+ int activeBorderWidth;
+ int leftEdge;
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ char *start = Tcl_UtfAtIndex(label, mePtr->underline);
+ char *end = Tcl_UtfNext(start);
+
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
if (menuPtr->menuType == MENUBAR) {
leftEdge += 5;
}
-
- Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, mePtr->label,
+
+ Tk_UnderlineChars(menuPtr->display, d, gc, tkfont, label,
leftEdge, y + (height + fmPtr->ascent - fmPtr->descent) / 2,
- mePtr->underline, mePtr->underline + 1);
+ start - label, end - label);
}
}
@@ -866,7 +903,7 @@ GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
*widthPtr = 0;
} else {
*heightPtr = fmPtr->linespace;
- *widthPtr = Tk_TextWidth(tkfont, "W", -1);
+ *widthPtr = Tk_TextWidth(tkfont, "W", 1);
}
}
@@ -897,29 +934,39 @@ TkpComputeMenubarGeometry(menuPtr)
Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
int width, height;
int i, j;
- int x, y, currentRowHeight, currentRowWidth, maxWidth;
+ 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;
- x = y = menuPtr->borderWidth;
+ Tk_GetPixelsFromObj(NULL, menuPtr->tkwin, menuPtr->borderWidthPtr,
+ &borderWidth);
+ x = y = borderWidth;
lastRowBreak = 0;
- currentRowWidth = 0;
/*
* On the Mac especially, getting font metrics can be quite slow,
@@ -929,21 +976,22 @@ TkpComputeMenubarGeometry(menuPtr)
* and if an entry has a font set, we will measure it as we come
* to it, and then we decide which set to give the geometry routines.
*/
-
- Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
+
+ 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;
- tkfont = mePtr->tkfont;
- if (tkfont == NULL) {
- tkfont = menuPtr->tkfont;
- fmPtr = &menuMetrics;
- } else {
+ 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
@@ -956,24 +1004,21 @@ TkpComputeMenubarGeometry(menuPtr)
|| (mePtr->type == TEAROFF_ENTRY)) {
mePtr->height = mePtr->width = 0;
} else {
-
- GetMenuLabelGeometry(mePtr, tkfont, fmPtr,
- &width, &height);
- mePtr->height = height + 2 * menuPtr->activeBorderWidth + 10;
+ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, &width, &height);
+ mePtr->height = height + 2 * activeBorderWidth + 10;
mePtr->width = width;
-
- GetMenuIndicatorGeometry(menuPtr, mePtr,
- tkfont, fmPtr, &width, &height);
+
+ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr,
+ &width, &height);
mePtr->indicatorSpace = width;
if (width > 0) {
mePtr->width += width;
}
- mePtr->width += 2 * menuPtr->activeBorderWidth + 10;
+ mePtr->width += 2 * activeBorderWidth + 10;
}
if (mePtr->entryFlags & ENTRY_HELP_MENU) {
helpMenuIndex = i;
- } else if (x + mePtr->width + menuPtr->borderWidth
- > maxWindowWidth) {
+ } else if (x + mePtr->width + borderWidth > maxWindowWidth) {
if (i == lastRowBreak) {
mePtr->y = y;
@@ -982,7 +1027,7 @@ TkpComputeMenubarGeometry(menuPtr)
y += mePtr->height;
currentRowHeight = 0;
} else {
- x = menuPtr->borderWidth;
+ x = borderWidth;
for (j = lastRowBreak; j < i; j++) {
menuPtr->entries[j]->y = y + currentRowHeight
- menuPtr->entries[j]->height;
@@ -996,7 +1041,7 @@ TkpComputeMenubarGeometry(menuPtr)
if (x > maxWidth) {
maxWidth = x;
}
- x = menuPtr->borderWidth;
+ x = borderWidth;
} else {
x += mePtr->width;
if (mePtr->height > currentRowHeight) {
@@ -1010,11 +1055,10 @@ TkpComputeMenubarGeometry(menuPtr)
lastEntry--;
}
if ((lastEntry >= 0) && (x + menuPtr->entries[lastEntry]->width
- + menuPtr->borderWidth > maxWidth)) {
- maxWidth = x + menuPtr->entries[lastEntry]->width
- + menuPtr->borderWidth;
+ + borderWidth > maxWidth)) {
+ maxWidth = x + menuPtr->entries[lastEntry]->width + borderWidth;
}
- x = menuPtr->borderWidth;
+ x = borderWidth;
for (j = lastRowBreak; j < menuPtr->numEntries; j++) {
if (j == helpMenuIndex) {
continue;
@@ -1028,17 +1072,17 @@ TkpComputeMenubarGeometry(menuPtr)
if (helpMenuIndex != -1) {
mePtr = menuPtr->entries[helpMenuIndex];
- if (x + mePtr->width + menuPtr->borderWidth > maxWindowWidth) {
+ if (x + mePtr->width + borderWidth > maxWindowWidth) {
y += currentRowHeight;
currentRowHeight = mePtr->height;
- x = menuPtr->borderWidth;
+ x = borderWidth;
} else if (mePtr->height > currentRowHeight) {
currentRowHeight = mePtr->height;
}
- mePtr->x = maxWindowWidth - menuPtr->borderWidth - mePtr->width;
+ mePtr->x = maxWindowWidth - borderWidth - mePtr->width;
mePtr->y = y + currentRowHeight - mePtr->height;
}
- height = y + currentRowHeight + menuPtr->borderWidth;
+ height = y + currentRowHeight + borderWidth;
}
width = Tk_Width(menuPtr->tkwin);
@@ -1088,27 +1132,28 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
int height;
{
XPoint points[2];
- int margin, segmentWidth, maxX;
+ int 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, menuPtr->border, points, 2, 1,
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
TK_RELIEF_RAISED);
- points[0].x += 2*segmentWidth;
+ points[0].x += 2 * segmentWidth;
}
}
@@ -1235,8 +1280,7 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
* Choose the gc for drawing the foreground part of the entry.
*/
- if ((mePtr->state == tkActiveUid)
- && !strictMotif) {
+ if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {
gc = mePtr->activeGC;
if (gc == NULL) {
gc = menuPtr->activeGC;
@@ -1248,17 +1292,21 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
cascadeEntryPtr != NULL;
cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
- if (strcmp(cascadeEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) == 0) {
- if (cascadeEntryPtr->state == tkDisabledUid) {
- parentDisabled = 1;
+ 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;
}
- break;
}
}
- if (((parentDisabled || (mePtr->state == tkDisabledUid)))
- && (menuPtr->disabledFg != NULL)) {
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
gc = mePtr->disabledGC;
if (gc == NULL) {
gc = menuPtr->disabledGC;
@@ -1274,24 +1322,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
if (indicatorGC == NULL) {
indicatorGC = menuPtr->indicatorGC;
}
-
- bgBorder = mePtr->border;
- if (bgBorder == NULL) {
- bgBorder = menuPtr->border;
- }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL)
+ ? menuPtr->borderPtr : mePtr->borderPtr);
if (strictMotif) {
activeBorder = bgBorder;
} else {
- activeBorder = mePtr->activeBorder;
- if (activeBorder == NULL) {
- activeBorder = menuPtr->activeBorder;
- }
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL)
+ ? menuPtr->activeBorderPtr : mePtr->activeBorderPtr);
}
- if (mePtr->tkfont == NULL) {
+ if (mePtr->fontPtr == NULL) {
fmPtr = menuMetricsPtr;
} else {
- tkfont = mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -1354,13 +1400,16 @@ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr)
if (mePtr->image != NULL) {
Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
- } else if (mePtr->bitmap != (Pixmap) NULL) {
- Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
+ } else 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->label != NULL) {
- *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength);
+ if (mePtr->labelPtr != NULL) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+
+ *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength);
} else {
*widthPtr = 0;
}
@@ -1392,18 +1441,23 @@ TkpComputeStandardMenuGeometry(
menuPtr) /* Structure describing menu. */
TkMenu *menuPtr;
{
- Tk_Font tkfont;
+ 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;
}
- x = y = menuPtr->borderWidth;
+ 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;
@@ -1418,20 +1472,21 @@ TkpComputeStandardMenuGeometry(
* give all of the geometry/drawing the entry's font and metrics.
*/
- Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
- accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1);
+ 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];
- tkfont = mePtr->tkfont;
- if (tkfont == NULL) {
- tkfont = menuPtr->tkfont;
- fmPtr = &menuMetrics;
- } else {
- Tk_GetFontMetrics(tkfont, &entryMetrics);
- fmPtr = &entryMetrics;
- }
-
+ 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;
@@ -1440,16 +1495,16 @@ TkpComputeStandardMenuGeometry(
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
- + accelWidth + 2 * menuPtr->activeBorderWidth;
+ + accelWidth + 2 * activeBorderWidth;
menuPtr->entries[j]->x = x;
menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
}
x += indicatorSpace + labelWidth + accelWidth
- + 2 * menuPtr->activeBorderWidth;
+ + 2 * activeBorderWidth;
windowWidth = x;
indicatorSpace = labelWidth = accelWidth = 0;
lastColumnBreak = i;
- y = menuPtr->borderWidth;
+ y = borderWidth;
}
if (mePtr->type == SEPARATOR_ENTRY) {
@@ -1507,8 +1562,7 @@ TkpComputeStandardMenuGeometry(
indicatorSpace = width;
}
- mePtr->height += 2 * menuPtr->activeBorderWidth +
- MENU_DIVIDER_HEIGHT;
+ mePtr->height += 2 * activeBorderWidth + MENU_DIVIDER_HEIGHT;
}
mePtr->y = y;
y += mePtr->height;
@@ -1524,15 +1578,15 @@ TkpComputeStandardMenuGeometry(
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
- + accelWidth + 2 * menuPtr->activeBorderWidth;
+ + accelWidth + 2 * activeBorderWidth;
menuPtr->entries[j]->x = x;
menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
}
windowWidth = x + indicatorSpace + labelWidth + accelWidth
- + 2 * menuPtr->activeBorderWidth + 2 * menuPtr->borderWidth;
+ + 2 * activeBorderWidth + 2 * borderWidth;
- windowHeight += menuPtr->borderWidth;
+ windowHeight += borderWidth;
/*
* The X server doesn't like zero dimensions, so round up to at least
@@ -1601,3 +1655,31 @@ 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/tk/unix/tkUnixMenubu.c b/tk/unix/tkUnixMenubu.c
index ac7c8796ceb..c188af991ae 100644
--- a/tk/unix/tkUnixMenubu.c
+++ b/tk/unix/tkUnixMenubu.c
@@ -84,10 +84,11 @@ TkpDisplayMenuButton(clientData)
return;
}
- if ((mbPtr->state == tkDisabledUid) && (mbPtr->disabledFg != NULL)) {
+ if ((mbPtr->state == STATE_DISABLED) && (mbPtr->disabledFg != NULL)) {
gc = mbPtr->disabledGC;
border = mbPtr->normalBorder;
- } else if ((mbPtr->state == tkActiveUid) && !Tk_StrictMotif(mbPtr->tkwin)) {
+ } else if ((mbPtr->state == STATE_ACTIVE)
+ && !Tk_StrictMotif(mbPtr->tkwin)) {
gc = mbPtr->activeTextGC;
border = mbPtr->activeBorder;
} else {
@@ -142,8 +143,8 @@ TkpDisplayMenuButton(clientData)
* foreground color, generate the stippled effect.
*/
- if ((mbPtr->state == tkDisabledUid)
- && ((mbPtr->disabledFg == NULL) || (mbPtr->image != NULL))) {
+ 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),
@@ -248,7 +249,7 @@ TkpDestroyMenuButton(mbPtr)
void
TkpComputeMenuButtonGeometry(mbPtr)
- register TkMenuButton *mbPtr; /* Widget record for menu button. */
+ TkMenuButton *mbPtr; /* Widget record for menu button. */
{
int width, height, mm, pixels;
@@ -305,3 +306,4 @@ TkpComputeMenuButtonGeometry(mbPtr)
(int) (height + 2*mbPtr->inset));
Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset);
}
+
diff --git a/tk/unix/tkUnixPort.h b/tk/unix/tkUnixPort.h
index 1b3fcbe2132..46951b67133 100644
--- a/tk/unix/tkUnixPort.h
+++ b/tk/unix/tkUnixPort.h
@@ -7,7 +7,6 @@
*
* Copyright (c) 1991-1993 The Regents of the University of California.
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -186,12 +185,12 @@ extern int errno;
* in any other header file.
*/
-extern void panic _ANSI_ARGS_(TCL_VARARGS(char *, string));
/*
* These functions do nothing under Unix, so we just eliminate calls to them.
*/
+#define TkpButtonSetDefaults(specPtr) {}
#define TkpDestroyButton(butPtr) {}
#define TkSelUpdateClipboard(a,b) {}
#define TkSetPixmapColormap(p,c) {}
@@ -231,6 +230,9 @@ extern void panic _ANSI_ARGS_(TCL_VARARGS(char *, string));
* that is needed for portability reasons.
*/
-EXTERN void TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
#endif /* _UNIXPORT */
+
diff --git a/tk/unix/tkUnixScale.c b/tk/unix/tkUnixScale.c
index 6378c03b70e..a05bbbef37d 100644
--- a/tk/unix/tkUnixScale.c
+++ b/tk/unix/tkUnixScale.c
@@ -5,6 +5,7 @@
* 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.
@@ -56,7 +57,9 @@ TkpCreateScale(tkwin)
*
* TkpDestroyScale --
*
- * Destroy a TkScale structure.
+ * 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
@@ -71,7 +74,7 @@ void
TkpDestroyScale(scalePtr)
TkScale *scalePtr;
{
- ckfree((char *) scalePtr);
+ Tcl_EventuallyFree((ClientData) scalePtr, TCL_DYNAMIC);
}
/*
@@ -107,7 +110,7 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
{
Tk_Window tkwin = scalePtr->tkwin;
int x, y, width, height, shadowWidth;
- double tickValue;
+ double tickValue, tickInterval = scalePtr->tickInterval;
Tk_3DBorder sliderBorder;
/*
@@ -129,9 +132,22 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
* Display the tick marks.
*/
- if (scalePtr->tickInterval != 0) {
+ 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 += scalePtr->tickInterval) {
+ tickValue += tickInterval) {
/*
* The TkRoundToResolution call gets rid of accumulated
* round-off errors, if any.
@@ -177,7 +193,7 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
(unsigned) scalePtr->width,
(unsigned) (Tk_Height(tkwin) - 2*scalePtr->inset
- 2*scalePtr->borderWidth));
- if (scalePtr->state == tkActiveUid) {
+ if (scalePtr->state == STATE_ACTIVE) {
sliderBorder = scalePtr->activeBorder;
} else {
sliderBorder = scalePtr->bgBorder;
@@ -185,7 +201,7 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
width = scalePtr->width;
height = scalePtr->sliderLength/2;
x = scalePtr->vertTroughX + scalePtr->borderWidth;
- y = TkpValueToPixel(scalePtr, scalePtr->value) - height;
+ y = TkScaleValueToPixel(scalePtr, scalePtr->value) - height;
shadowWidth = scalePtr->borderWidth/2;
if (shadowWidth == 0) {
shadowWidth = 1;
@@ -210,8 +226,9 @@ DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
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);
+ scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength, scalePtr->vertLabelX,
+ scalePtr->inset + (3*fm.ascent)/2);
}
}
@@ -252,7 +269,7 @@ DisplayVerticalValue(scalePtr, drawable, value, rightEdge)
Tk_FontMetrics fm;
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
- y = TkpValueToPixel(scalePtr, value) + fm.ascent/2;
+ y = TkScaleValueToPixel(scalePtr, value) + fm.ascent/2;
sprintf(valueString, scalePtr->format, value);
length = strlen(valueString);
width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
@@ -305,7 +322,7 @@ DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr)
{
register Tk_Window tkwin = scalePtr->tkwin;
int x, y, width, height, shadowWidth;
- double tickValue;
+ double tickValue, tickInterval = scalePtr->tickInterval;
Tk_3DBorder sliderBorder;
/*
@@ -327,9 +344,25 @@ DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr)
* Display the tick marks.
*/
- if (scalePtr->tickInterval != 0) {
+ 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 += scalePtr->tickInterval) {
+ tickValue += tickInterval) {
/*
* The TkRoundToResolution call gets rid of accumulated
* round-off errors, if any.
@@ -376,14 +409,14 @@ DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr)
(unsigned) (Tk_Width(tkwin) - 2*scalePtr->inset
- 2*scalePtr->borderWidth),
(unsigned) scalePtr->width);
- if (scalePtr->state == tkActiveUid) {
+ if (scalePtr->state == STATE_ACTIVE) {
sliderBorder = scalePtr->activeBorder;
} else {
sliderBorder = scalePtr->bgBorder;
}
width = scalePtr->sliderLength/2;
height = scalePtr->width;
- x = TkpValueToPixel(scalePtr, scalePtr->value) - width;
+ x = TkScaleValueToPixel(scalePtr, scalePtr->value) - width;
y += scalePtr->borderWidth;
shadowWidth = scalePtr->borderWidth/2;
if (shadowWidth == 0) {
@@ -409,8 +442,9 @@ DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr)
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);
+ scalePtr->tkfont, scalePtr->label,
+ scalePtr->labelLength, scalePtr->inset + fm.ascent/2,
+ scalePtr->horizLabelY + fm.ascent);
}
}
@@ -450,7 +484,7 @@ DisplayHorizontalValue(scalePtr, drawable, value, top)
char valueString[PRINT_CHARS];
Tk_FontMetrics fm;
- x = TkpValueToPixel(scalePtr, value);
+ x = TkScaleValueToPixel(scalePtr, value);
Tk_GetFontMetrics(scalePtr->tkfont, &fm);
y = top + fm.ascent;
sprintf(valueString, scalePtr->format, value);
@@ -502,6 +536,7 @@ TkpDisplayScale(clientData)
char string[PRINT_CHARS];
XRectangle drawnArea;
+ scalePtr->flags &= ~REDRAW_PENDING;
if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
goto done;
}
@@ -509,23 +544,22 @@ TkpDisplayScale(clientData)
/*
* Invoke the scale's command if needed.
*/
-
Tcl_Preserve((ClientData) scalePtr);
- Tcl_Preserve((ClientData) interp);
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);
+ 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);
}
- Tcl_Release((ClientData) interp);
scalePtr->flags &= ~INVOKE_COMMAND;
- if (scalePtr->tkwin == NULL) {
+ if (scalePtr->flags & SCALE_DELETED) {
Tcl_Release((ClientData) scalePtr);
- return;
+ goto done;
}
Tcl_Release((ClientData) scalePtr);
@@ -549,7 +583,7 @@ TkpDisplayScale(clientData)
* different.
*/
- if (scalePtr->vertical) {
+ if (scalePtr->orient == ORIENT_VERTICAL) {
DisplayVerticalScale(scalePtr, pixmap, &drawnArea);
} else {
DisplayHorizontalScale(scalePtr, pixmap, &drawnArea);
@@ -575,7 +609,8 @@ TkpDisplayScale(clientData)
if (scalePtr->flags & GOT_FOCUS) {
gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
} else {
- gc = Tk_GCForColor(scalePtr->highlightBgColorPtr, pixmap);
+ gc = Tk_GCForColor(
+ Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
}
Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
}
@@ -621,7 +656,7 @@ TkpScaleElement(scalePtr, x, y)
{
int sliderFirst;
- if (scalePtr->vertical) {
+ if (scalePtr->orient == ORIENT_VERTICAL) {
if ((x < scalePtr->vertTroughX)
|| (x >= (scalePtr->vertTroughX + 2*scalePtr->borderWidth +
scalePtr->width))) {
@@ -631,7 +666,7 @@ TkpScaleElement(scalePtr, x, y)
|| (y >= (Tk_Height(scalePtr->tkwin) - scalePtr->inset))) {
return OTHER;
}
- sliderFirst = TkpValueToPixel(scalePtr, scalePtr->value)
+ sliderFirst = TkScaleValueToPixel(scalePtr, scalePtr->value)
- scalePtr->sliderLength/2;
if (y < sliderFirst) {
return TROUGH1;
@@ -651,7 +686,7 @@ TkpScaleElement(scalePtr, x, y)
|| (x >= (Tk_Width(scalePtr->tkwin) - scalePtr->inset))) {
return OTHER;
}
- sliderFirst = TkpValueToPixel(scalePtr, scalePtr->value)
+ sliderFirst = TkScaleValueToPixel(scalePtr, scalePtr->value)
- scalePtr->sliderLength/2;
if (x < sliderFirst) {
return TROUGH1;
@@ -661,168 +696,3 @@ TkpScaleElement(scalePtr, x, y)
}
return TROUGH2;
}
-
-/*
- *--------------------------------------------------------------
- *
- * TkpSetScaleValue --
- *
- * This procedure changes the value of a scale and invokes
- * a Tcl command to reflect the current position of a scale
- *
- * Results:
- * None.
- *
- * Side effects:
- * A Tcl command is invoked, and an additional error-processing
- * command may also be invoked. The scale's slider is redrawn.
- *
- *--------------------------------------------------------------
- */
-
-void
-TkpSetScaleValue(scalePtr, value, setVar, invokeCommand)
- register TkScale *scalePtr; /* Info about widget. */
- double value; /* New value for scale. Gets adjusted
- * if it's off the scale. */
- int setVar; /* Non-zero means reflect new value through
- * to associated variable, if any. */
- int invokeCommand; /* Non-zero means invoked -command option
- * to notify of new value, 0 means don't. */
-{
- char string[PRINT_CHARS];
-
- value = TkRoundToResolution(scalePtr, value);
- if ((value < scalePtr->fromValue)
- ^ (scalePtr->toValue < scalePtr->fromValue)) {
- value = scalePtr->fromValue;
- }
- if ((value > scalePtr->toValue)
- ^ (scalePtr->toValue < scalePtr->fromValue)) {
- value = scalePtr->toValue;
- }
- if (scalePtr->flags & NEVER_SET) {
- scalePtr->flags &= ~NEVER_SET;
- } else if (scalePtr->value == value) {
- return;
- }
- scalePtr->value = value;
- if (invokeCommand) {
- scalePtr->flags |= INVOKE_COMMAND;
- }
- TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);
-
- if (setVar && (scalePtr->varName != NULL)) {
- sprintf(string, scalePtr->format, scalePtr->value);
- scalePtr->flags |= SETTING_VAR;
- Tcl_SetVar(scalePtr->interp, scalePtr->varName, string,
- TCL_GLOBAL_ONLY);
- scalePtr->flags &= ~SETTING_VAR;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TkpPixelToValue --
- *
- * Given a pixel within a scale window, return the scale
- * reading corresponding to that pixel.
- *
- * Results:
- * A double-precision scale reading. If the value is outside
- * the legal range for the scale then it's rounded to the nearest
- * end of the scale.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-double
-TkpPixelToValue(scalePtr, x, y)
- register TkScale *scalePtr; /* Information about widget. */
- int x, y; /* Coordinates of point within
- * window. */
-{
- double value, pixelRange;
-
- if (scalePtr->vertical) {
- pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength
- - 2*scalePtr->inset - 2*scalePtr->borderWidth;
- value = y;
- } else {
- pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength
- - 2*scalePtr->inset - 2*scalePtr->borderWidth;
- value = x;
- }
-
- if (pixelRange <= 0) {
- /*
- * Not enough room for the slider to actually slide: just return
- * the scale's current value.
- */
-
- return scalePtr->value;
- }
- value -= scalePtr->sliderLength/2 + scalePtr->inset
- + scalePtr->borderWidth;
- value /= pixelRange;
- if (value < 0) {
- value = 0;
- }
- if (value > 1) {
- value = 1;
- }
- value = scalePtr->fromValue +
- value * (scalePtr->toValue - scalePtr->fromValue);
- return TkRoundToResolution(scalePtr, value);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TkpValueToPixel --
- *
- * Given a reading of the scale, return the x-coordinate or
- * y-coordinate corresponding to that reading, depending on
- * whether the scale is vertical or horizontal, respectively.
- *
- * Results:
- * An integer value giving the pixel location corresponding
- * to reading. The value is restricted to lie within the
- * defined range for the scale.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TkpValueToPixel(scalePtr, value)
- register TkScale *scalePtr; /* Information about widget. */
- double value; /* Reading of the widget. */
-{
- int y, pixelRange;
- double valueRange;
-
- valueRange = scalePtr->toValue - scalePtr->fromValue;
- pixelRange = (scalePtr->vertical ? Tk_Height(scalePtr->tkwin)
- : Tk_Width(scalePtr->tkwin)) - scalePtr->sliderLength
- - 2*scalePtr->inset - 2*scalePtr->borderWidth;
- if (valueRange == 0) {
- y = 0;
- } else {
- y = (int) ((value - scalePtr->fromValue) * pixelRange
- / valueRange + 0.5);
- if (y < 0) {
- y = 0;
- } else if (y > pixelRange) {
- y = pixelRange;
- }
- }
- y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth;
- return y;
-}
diff --git a/tk/unix/tkUnixScrlbr.c b/tk/unix/tkUnixScrlbr.c
index 6861ed33da2..7704250eb01 100644
--- a/tk/unix/tkUnixScrlbr.c
+++ b/tk/unix/tkUnixScrlbr.c
@@ -474,3 +474,4 @@ TkpScrollbarPosition(scrollPtr, x, y)
}
return BOTTOM_GAP;
}
+
diff --git a/tk/unix/tkUnixSelect.c b/tk/unix/tkUnixSelect.c
index e42da31d91c..d240b1e0f40 100644
--- a/tk/unix/tkUnixSelect.c
+++ b/tk/unix/tkUnixSelect.c
@@ -4,7 +4,7 @@
* This file contains X specific routines for manipulating
* selections.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * 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.
@@ -15,6 +15,19 @@
#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
@@ -31,17 +44,21 @@ typedef struct IncrInfo {
* MULTIPLE retrievals) or to a static
* array. */
unsigned long numConversions;
- /* Number of entries in offsets (same as
+ /* Number of entries in converts (same as
* # of pairs in multAtoms). */
- int *offsets; /* One entry for each pair in
- * multAtoms; -1 means all data has
- * been transferred for this
- * conversion. -2 means only the
- * final zero-length transfer still
- * has to be done. Otherwise it is the
- * offset of the next chunk of data
- * to transfer. This array is malloc-ed. */
- int numIncrs; /* Number of entries in offsets that
+ 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. */
@@ -57,9 +74,12 @@ typedef struct IncrInfo {
* retrievals currently pending. */
} IncrInfo;
-static IncrInfo *pendingIncrs = NULL;
- /* List of all incr structures
+
+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
@@ -98,7 +118,7 @@ static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
* Results:
* The return value is a standard Tcl return value.
* If an error occurs (such as no selection exists)
- * then an error message is left in interp->result.
+ * then an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -147,7 +167,9 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
retr.clientData = clientData;
retr.result = -1;
retr.idleTime = 0;
+ retr.encFlags = TCL_ENCODING_START;
retr.nextPtr = pendingRetrievals;
+ Tcl_DStringInit(&retr.buf);
pendingRetrievals = &retr;
/*
@@ -192,6 +214,7 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
}
}
}
+ Tcl_DStringFree(&retr.buf);
return retr.result;
}
@@ -223,13 +246,19 @@ TkSelPropProc(eventPtr)
register XEvent *eventPtr; /* X PropertyChange event. */
{
register IncrInfo *incrPtr;
- int i, format;
+ 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];
- int numItems;
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
@@ -240,91 +269,234 @@ TkSelPropProc(eventPtr)
if (eventPtr->xproperty.state != PropertyDelete) {
return;
}
- for (incrPtr = pendingIncrs; incrPtr != NULL;
+ 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->offsets[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->offsets[i] = -1;
+ incrPtr->converts[i].offset = -1;
incrPtr->numIncrs --;
return;
}
if ((selPtr->target == target)
&& (selPtr->selection == incrPtr->selection)) {
- formatType = selPtr->format;
- if (incrPtr->offsets[i] == -2) {
- numItems = 0;
- ((char *) buffer)[0] = 0;
- } else {
- TkSelInProgress ip;
- ip.selPtr = selPtr;
- ip.nextPtr = pendingPtr;
- pendingPtr = &ip;
- numItems = (*selPtr->proc)(selPtr->clientData,
- incrPtr->offsets[i], (char *) buffer,
- TK_SEL_BYTES_AT_ONCE);
- pendingPtr = ip.nextPtr;
- if (ip.selPtr == NULL) {
- /*
- * The selection handler deleted itself.
- */
-
- return;
- }
- if (numItems > TK_SEL_BYTES_AT_ONCE) {
- panic("selection handler returned too many bytes");
- } else {
- if (numItems < 0) {
- numItems = 0;
- }
- }
- ((char *) buffer)[numItems] = '\0';
- }
- if (numItems < TK_SEL_BYTES_AT_ONCE) {
- if (numItems <= 0) {
- incrPtr->offsets[i] = -1;
- incrPtr->numIncrs--;
- } else {
- incrPtr->offsets[i] = -2;
- }
- } else {
- incrPtr->offsets[i] += numItems;
- }
- if (formatType == XA_STRING) {
- propPtr = (char *) buffer;
- format = 8;
- } else {
- propPtr = (char *) SelCvtToX((char *) buffer,
- formatType, (Tk_Window) incrPtr->winPtr,
- &numItems);
- format = 32;
+ 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;
}
- errorHandler = Tk_CreateErrorHandler(
- eventPtr->xproperty.display, -1, -1, -1,
- (int (*)()) NULL, (ClientData) NULL);
- XChangeProperty(eventPtr->xproperty.display,
- eventPtr->xproperty.window,
- eventPtr->xproperty.atom, formatType,
- format, PropModeReplace,
- (unsigned char *) propPtr, numItems);
- Tk_DeleteErrorHandler(errorHandler);
- if (propPtr != (char *) buffer) {
- ckfree(propPtr);
+ if (Tcl_DStringLength(&ds) == 0) {
+ Tcl_DStringSetLength(&ds, dstLen);
}
- return;
+ 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;
}
}
}
@@ -378,6 +550,7 @@ TkSelEventProc(tkwin, eventPtr)
Atom type;
int format, result;
unsigned long numItems, bytesAfter;
+ Tcl_DString ds;
for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
if (retrPtr == NULL) {
@@ -421,18 +594,45 @@ TkSelEventProc(tkwin, eventPtr)
}
if ((type == XA_STRING) || (type == dispPtr->textAtom)
|| (type == dispPtr->compoundTextAtom)) {
+ Tcl_Encoding encoding;
if (format != 8) {
- sprintf(retrPtr->interp->result,
- "bad format for string selection: wanted \"8\", got \"%d\"",
- format);
+ 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, propInfo);
- Tcl_Release((ClientData) interp);
+ interp, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_Release((ClientData) interp);
} else if (type == dispPtr->incrAtom) {
/*
@@ -456,9 +656,12 @@ TkSelEventProc(tkwin, eventPtr)
char *string;
if (format != 32) {
- sprintf(retrPtr->interp->result,
- "bad format for selection: wanted \"32\", got \"%d\"",
- format);
+ 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;
}
@@ -580,6 +783,8 @@ ConvertSelection(winPtr, eventPtr)
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);
@@ -657,8 +862,8 @@ ConvertSelection(winPtr, eventPtr)
* be returned below).
*/
- incr.offsets = (int *) ckalloc((unsigned)
- (incr.numConversions*sizeof(int)));
+ incr.converts = (ConvertInfo *) ckalloc((unsigned)
+ (incr.numConversions*sizeof(ConvertInfo)));
incr.numIncrs = 0;
for (i = 0; i < incr.numConversions; i++) {
Atom target, property, type;
@@ -669,7 +874,8 @@ ConvertSelection(winPtr, eventPtr)
target = incr.multAtoms[2*i];
property = incr.multAtoms[2*i + 1];
- incr.offsets[i] = -1;
+ incr.converts[i].offset = -1;
+ incr.converts[i].buffer[0] = '\0';
for (selPtr = winPtr->selHandlerList; selPtr != NULL;
selPtr = selPtr->nextPtr) {
@@ -694,12 +900,12 @@ ConvertSelection(winPtr, eventPtr)
}
} else {
ip.selPtr = selPtr;
- ip.nextPtr = pendingPtr;
- pendingPtr = &ip;
+ ip.nextPtr = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
type = selPtr->format;
numItems = (*selPtr->proc)(selPtr->clientData, 0,
(char *) buffer, TK_SEL_BYTES_AT_ONCE);
- pendingPtr = ip.nextPtr;
+ TkSelSetInProgress(ip.nextPtr);
if ((ip.selPtr == NULL) || (numItems < 0)) {
incr.multAtoms[2*i + 1] = None;
continue;
@@ -730,19 +936,42 @@ ConvertSelection(winPtr, eventPtr)
numItems = 1;
propPtr = (char *) buffer;
format = 32;
- incr.offsets[i] = 0;
- } else if (type == XA_STRING) {
- propPtr = (char *) buffer;
- format = 8;
+ incr.converts[i].offset = 0;
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, 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);
- if (propPtr != (char *) buffer) {
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
ckfree(propPtr);
}
}
@@ -761,8 +990,8 @@ ConvertSelection(winPtr, eventPtr)
incr.idleTime = 0;
incr.reqWindow = reply.requestor;
incr.time = infoPtr->time;
- incr.nextPtr = pendingIncrs;
- pendingIncrs = &incr;
+ incr.nextPtr = tsdPtr->pendingIncrs;
+ tsdPtr->pendingIncrs = &incr;
}
if (multiple) {
XChangeProperty(reply.display, reply.requestor, reply.property,
@@ -798,10 +1027,10 @@ ConvertSelection(winPtr, eventPtr)
-1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
XSelectInput(reply.display, reply.requestor, 0L);
Tk_DeleteErrorHandler(errorHandler);
- if (pendingIncrs == &incr) {
- pendingIncrs = incr.nextPtr;
+ if (tsdPtr->pendingIncrs == &incr) {
+ tsdPtr->pendingIncrs = incr.nextPtr;
} else {
- for (incrPtr2 = pendingIncrs; incrPtr2 != NULL;
+ for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL;
incrPtr2 = incrPtr2->nextPtr) {
if (incrPtr2->nextPtr == &incr) {
incrPtr2->nextPtr = incr.nextPtr;
@@ -815,7 +1044,7 @@ ConvertSelection(winPtr, eventPtr)
* All done. Cleanup and return.
*/
- ckfree((char *) incr.offsets);
+ ckfree((char *) incr.converts);
if (multiple) {
XFree((char *) incr.multAtoms);
}
@@ -860,11 +1089,13 @@ SelRcvIncrProc(clientData, eventPtr)
register XEvent *eventPtr; /* X PropertyChange event. */
{
register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
- char *propInfo;
+ char *propInfo, *dst, *src;
Atom type;
- int format, result;
+ 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)
@@ -885,34 +1116,120 @@ SelRcvIncrProc(clientData, eventPtr)
retrPtr->result = TCL_ERROR;
goto done;
}
- if (numItems == 0) {
- retrPtr->result = TCL_OK;
- } else if ((type == XA_STRING)
+ if ((type == XA_STRING)
|| (type == retrPtr->winPtr->dispPtr->textAtom)
|| (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
if (format != 8) {
- Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
- sprintf(retrPtr->interp->result,
- "bad format for string selection: wanted \"8\", got \"%d\"",
- format);
+ char buf[64 + TCL_INTEGER_SPACE];
+
+ sprintf(buf,
+ "bad format for string selection: wanted \"8\", got \"%d\"",
+ format);
+ Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE);
retrPtr->result = TCL_ERROR;
goto done;
}
interp = retrPtr->interp;
Tcl_Preserve((ClientData) interp);
- result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo);
+
+ 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;
+ 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) {
- Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
- sprintf(retrPtr->interp->result,
- "bad format for selection: wanted \"32\", got \"%d\"",
- format);
+ 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;
}
@@ -964,8 +1281,8 @@ SelectionSize(selPtr)
size = TK_SEL_BYTES_AT_ONCE;
ip.selPtr = selPtr;
- ip.nextPtr = pendingPtr;
- pendingPtr = &ip;
+ ip.nextPtr = TkSelGetInProgress();
+ TkSelSetInProgress(&ip);
do {
chunkSize = (*selPtr->proc)(selPtr->clientData, size,
(char *) buffer, TK_SEL_BYTES_AT_ONCE);
@@ -975,7 +1292,7 @@ SelectionSize(selPtr)
}
size += chunkSize;
} while (chunkSize == TK_SEL_BYTES_AT_ONCE);
- pendingPtr = ip.nextPtr;
+ TkSelSetInProgress(ip.nextPtr);
return size;
}
@@ -1187,3 +1504,4 @@ SelCvtFromX(propPtr, numValues, type, tkwin)
}
return result;
}
+
diff --git a/tk/unix/tkUnixSend.c b/tk/unix/tkUnixSend.c
index f9ce316a106..b661923e694 100644
--- a/tk/unix/tkUnixSend.c
+++ b/tk/unix/tkUnixSend.c
@@ -7,6 +7,7 @@
*
* 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.
@@ -39,10 +40,6 @@ typedef struct RegisteredInterp {
* NULL means end of list. */
} RegisteredInterp;
-static RegisteredInterp *registry = NULL;
- /* List of all interpreters
- * registered by this process. */
-
/*
* A registry of all interpreters for a display is kept in a
* property "InterpRegistry" on the root window of the display.
@@ -109,9 +106,15 @@ typedef struct PendingCommand {
* list. */
} PendingCommand;
-static PendingCommand *pendingCommands = NULL;
- /* List of all commands currently
+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
@@ -255,7 +258,7 @@ static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
* If "lock" is set then the server will be locked. It is the
* caller's responsibility to call RegClose when finished with
* the registry, so that we can write back the registry if
- * neeeded, unlock the server if needed, and free memory.
+ * needed, unlock the server if needed, and free memory.
*
*----------------------------------------------------------------------
*/
@@ -745,18 +748,15 @@ Tk_SetAppName(tkwin, name)
RegisteredInterp *riPtr, *riPtr2;
Window w;
TkWindow *winPtr = (TkWindow *) tkwin;
- TkDisplay *dispPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
NameRegistry *regPtr;
Tcl_Interp *interp;
char *actualName;
Tcl_DString dString;
int offset, i;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
-#ifdef __WIN32__
- return name;
-#endif /* __WIN32__ */
-
- dispPtr = winPtr->dispPtr;
interp = winPtr->mainPtr->interp;
if (dispPtr->commTkwin == NULL) {
SendInit(interp, winPtr->dispPtr);
@@ -768,7 +768,7 @@ Tk_SetAppName(tkwin, name)
*/
regPtr = RegOpen(interp, winPtr->dispPtr, 1);
- for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
+ for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
if (riPtr == NULL) {
/*
@@ -780,8 +780,9 @@ Tk_SetAppName(tkwin, name)
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
riPtr->dispPtr = winPtr->dispPtr;
- riPtr->nextPtr = registry;
- registry = riPtr;
+ riPtr->nextPtr = tsdPtr->interpListPtr;
+ tsdPtr->interpListPtr = riPtr;
+ riPtr->name = NULL;
Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
DeleteProc);
if (Tcl_IsSafe(interp)) {
@@ -795,8 +796,10 @@ Tk_SetAppName(tkwin, name)
* the name registry.
*/
- RegDeleteName(regPtr, riPtr->name);
- ckfree(riPtr->name);
+ if (riPtr->name) {
+ RegDeleteName(regPtr, riPtr->name);
+ ckfree(riPtr->name);
+ }
break;
}
}
@@ -835,7 +838,8 @@ Tk_SetAppName(tkwin, name)
*/
if (w == Tk_WindowId(dispPtr->commTkwin)) {
- for (riPtr2 = registry; riPtr2 != NULL; riPtr2 = riPtr2->nextPtr) {
+ for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
+ riPtr2 = riPtr2->nextPtr) {
if ((riPtr2->interp != interp) &&
(strcmp(riPtr2->name, actualName) == 0)) {
goto nextSuffix;
@@ -898,7 +902,7 @@ Tk_SendCmd(clientData, interp, argc, argv)
Window commWindow;
PendingCommand pending;
register RegisteredInterp *riPtr;
- char *destName, buffer[30];
+ char *destName;
int result, c, async, i, firstArg;
size_t length;
Tk_RestrictProc *prevRestrictProc;
@@ -907,6 +911,8 @@ Tk_SendCmd(clientData, interp, argc, argv)
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. */
@@ -968,7 +974,8 @@ Tk_SendCmd(clientData, interp, argc, argv)
* could be the same!
*/
- for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
if ((riPtr->dispPtr != dispPtr)
|| (strcmp(riPtr->name, destName) != 0)) {
continue;
@@ -990,6 +997,7 @@ Tk_SendCmd(clientData, interp, argc, argv)
}
if (interp != localInterp) {
if (result == TCL_ERROR) {
+ Tcl_Obj *errorObjPtr;
/*
* An error occurred, so transfer error information from the
@@ -1003,17 +1011,11 @@ Tk_SendCmd(clientData, interp, argc, argv)
Tcl_ResetResult(interp);
Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
- Tcl_SetVar2(interp, "errorCode", (char *) NULL,
- Tcl_GetVar2(localInterp, "errorCode", (char *) NULL,
- TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
+ errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
+ Tcl_SetObjErrorCode(interp, errorObjPtr);
}
- if (localInterp->freeProc != TCL_STATIC) {
- interp->result = localInterp->result;
- interp->freeProc = localInterp->freeProc;
- localInterp->freeProc = TCL_STATIC;
- } else {
- Tcl_SetResult(interp, localInterp->result, TCL_VOLATILE);
- }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
Tcl_ResetResult(localInterp);
}
Tcl_Release((ClientData) riPtr);
@@ -1044,6 +1046,8 @@ Tk_SendCmd(clientData, interp, argc, argv)
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);
@@ -1087,8 +1091,8 @@ Tk_SendCmd(clientData, interp, argc, argv)
pending.errorInfo = NULL;
pending.errorCode = NULL;
pending.gotResponse = 0;
- pending.nextPtr = pendingCommands;
- pendingCommands = &pending;
+ pending.nextPtr = tsdPtr->pendingCommands;
+ tsdPtr->pendingCommands = &pending;
/*
* Enter a loop processing X events until the result comes
@@ -1136,10 +1140,10 @@ Tk_SendCmd(clientData, interp, argc, argv)
* and return the result.
*/
- if (pendingCommands != &pending) {
+ if (tsdPtr->pendingCommands != &pending) {
panic("Tk_SendCmd: corrupted send stack");
}
- pendingCommands = pending.nextPtr;
+ tsdPtr->pendingCommands = pending.nextPtr;
if (pending.errorInfo != NULL) {
/*
* Special trick: must clear the interp's result before calling
@@ -1153,8 +1157,9 @@ Tk_SendCmd(clientData, interp, argc, argv)
ckfree(pending.errorInfo);
}
if (pending.errorCode != NULL) {
- Tcl_SetVar2(interp, "errorCode", (char *) NULL, pending.errorCode,
- TCL_GLOBAL_ONLY);
+ Tcl_Obj *errorObjPtr;
+ errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1);
+ Tcl_SetObjErrorCode(interp, errorObjPtr);
ckfree(pending.errorCode);
}
Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
@@ -1171,10 +1176,10 @@ Tk_SendCmd(clientData, interp, argc, argv)
* of a particular window.
*
* Results:
- * A standard Tcl return value. Interp->result will be set
+ * 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 interp->result will hold an error message.
+ * is returned and the interp's result will hold an error message.
*
* Side effects:
* None.
@@ -1339,6 +1344,8 @@ SendEventProc(clientData, eventPtr)
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)) {
@@ -1463,7 +1470,7 @@ SendEventProc(clientData, eventPtr)
* Locate the application, then execute the script.
*/
- for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
+ for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
if (riPtr == NULL) {
if (commWindow != None) {
Tcl_DStringAppend(&reply,
@@ -1498,7 +1505,8 @@ SendEventProc(clientData, eventPtr)
*/
if (commWindow != None) {
- Tcl_DStringAppend(&reply, remoteInterp->result, -1);
+ Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp),
+ -1);
if (result == TCL_ERROR) {
char *varValue;
@@ -1529,7 +1537,7 @@ SendEventProc(clientData, eventPtr)
returnResult:
if (commWindow != None) {
if (result != TCL_OK) {
- char buffer[20];
+ char buffer[TCL_INTEGER_SPACE];
sprintf(buffer, "%d", result);
Tcl_DStringAppend(&reply, "\0-c ", 4);
@@ -1604,7 +1612,7 @@ SendEventProc(clientData, eventPtr)
* waiting for it.
*/
- for (pcPtr = pendingCommands; pcPtr != NULL;
+ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
pcPtr = pcPtr->nextPtr) {
if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
continue;
@@ -1702,6 +1710,8 @@ AppendErrorProc(clientData, errorPtr)
{
PendingCommand *pendingPtr = (PendingCommand *) clientData;
register PendingCommand *pcPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (pendingPtr == NULL) {
return 0;
@@ -1711,7 +1721,7 @@ AppendErrorProc(clientData, errorPtr)
* Make sure this command is still pending.
*/
- for (pcPtr = pendingCommands; pcPtr != NULL;
+ for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
pcPtr = pcPtr->nextPtr) {
if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
pcPtr->result = (char *) ckalloc((unsigned)
@@ -1751,15 +1761,17 @@ DeleteProc(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 (registry == riPtr) {
- registry = riPtr->nextPtr;
+ if (tsdPtr->interpListPtr == riPtr) {
+ tsdPtr->interpListPtr = riPtr->nextPtr;
} else {
- for (riPtr2 = registry; riPtr2 != NULL;
+ for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
riPtr2 = riPtr2->nextPtr) {
if (riPtr2->nextPtr == riPtr) {
riPtr2->nextPtr = riPtr->nextPtr;
@@ -1803,7 +1815,8 @@ SendRestrictProc(clientData, eventPtr)
if (eventPtr->type != PropertyNotify) {
return TK_DEFER_EVENT;
}
- for (dispPtr = tkDisplayList; dispPtr != NULL; dispPtr = dispPtr->nextPtr) {
+ for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
if ((eventPtr->xany.display == dispPtr->display)
&& (eventPtr->xproperty.window
== Tk_WindowId(dispPtr->commTkwin))) {
@@ -1838,9 +1851,12 @@ UpdateCommWindow(dispPtr)
{
Tcl_DString names;
RegisteredInterp *riPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_DStringInit(&names);
- for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
Tcl_DStringAppendElement(&names, riPtr->name);
}
XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
@@ -1849,3 +1865,4 @@ UpdateCommWindow(dispPtr)
Tcl_DStringLength(&names));
Tcl_DStringFree(&names);
}
+
diff --git a/tk/unix/tkUnixWm.c b/tk/unix/tkUnixWm.c
index 4251c52ab23..98e4861f044 100644
--- a/tk/unix/tkUnixWm.c
+++ b/tk/unix/tkUnixWm.c
@@ -8,7 +8,6 @@
*
* Copyright (c) 1991-1994 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -267,21 +266,10 @@ typedef struct TkWmInfo {
/*
* This module keeps a list of all top-level windows, primarily to
- * simplify the job of Tk_CoordsToWindow.
+ * simplify the job of Tk_CoordsToWindow. The list is called
+ * firstWmPtr and is stored in the TkDisplay structure.
*/
-static WmInfo *firstWmPtr = NULL; /* Points to first top-level window. */
-
-
-/*
- * The variable below is used to enable or disable tracing in this
- * module. If tracing is enabled, then information is printed on
- * standard output about interesting interactions with the window
- * manager.
- */
-
-static int wmTracing = 0;
-
/*
* The following structures are the official type records for geometry
* management of top-level and menubar windows.
@@ -337,6 +325,7 @@ static void ReparentEvent _ANSI_ARGS_((WmInfo *wmPtr,
XReparentEvent *eventPtr));
static void TopLevelReqProc _ANSI_ARGS_((ClientData dummy,
Tk_Window tkwin));
+static void UpdateCommand _ANSI_ARGS_((TkWindow *winPtr));
static void UpdateGeometryInfo _ANSI_ARGS_((
ClientData clientData));
static void UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
@@ -378,6 +367,7 @@ TkWmNewWindow(winPtr)
TkWindow *winPtr; /* Newly-created top-level window. */
{
register WmInfo *wmPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
wmPtr->winPtr = winPtr;
@@ -433,8 +423,8 @@ TkWmNewWindow(winPtr)
wmPtr->cmdArgv = NULL;
wmPtr->clientMachine = NULL;
wmPtr->flags = WM_NEVER_MAPPED;
- wmPtr->nextPtr = firstWmPtr;
- firstWmPtr = wmPtr;
+ wmPtr->nextPtr = (WmInfo *) dispPtr->firstWmPtr;
+ dispPtr->firstWmPtr = wmPtr;
winPtr->wmInfoPtr = wmPtr;
UpdateVRootGeometry(wmPtr);
@@ -480,6 +470,8 @@ TkWmMapWindow(winPtr)
char *string;
if (wmPtr->flags & WM_NEVER_MAPPED) {
+ Tcl_DString ds;
+
wmPtr->flags &= ~WM_NEVER_MAPPED;
/*
@@ -498,16 +490,22 @@ TkWmMapWindow(winPtr)
*/
string = (wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid;
- if (XStringListToTextProperty(&string, 1, &textProp) != 0) {
+ 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,
- wmPtr->iconName);
+ Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
}
if (wmPtr->master != None) {
@@ -519,16 +517,17 @@ TkWmMapWindow(winPtr)
UpdateHints(winPtr);
UpdateWmProtocols(wmPtr);
if (wmPtr->cmdArgv != NULL) {
- XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
- wmPtr->cmdArgv, wmPtr->cmdArgc);
+ UpdateCommand(winPtr);
}
if (wmPtr->clientMachine != NULL) {
- if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp)
- != 0) {
+ 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) {
@@ -630,12 +629,13 @@ TkWmDeadWindow(winPtr)
if (wmPtr == NULL) {
return;
}
- if (firstWmPtr == wmPtr) {
- firstWmPtr = wmPtr->nextPtr;
+ if ((WmInfo *) winPtr->dispPtr->firstWmPtr == wmPtr) {
+ winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
} else {
register WmInfo *prevPtr;
- for (prevPtr = firstWmPtr; ; prevPtr = prevPtr->nextPtr) {
+ for (prevPtr = (WmInfo *) winPtr->dispPtr->firstWmPtr; ;
+ prevPtr = prevPtr->nextPtr) {
if (prevPtr == NULL) {
panic("couldn't unlink window in TkWmDeadWindow");
}
@@ -740,13 +740,18 @@ TkWmSetClass(winPtr)
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 = winPtr->nameUid;
- classPtr->res_class = winPtr->classUid;
+ 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);
}
}
@@ -781,6 +786,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
register WmInfo *wmPtr;
int c;
size_t length;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (argc < 2) {
wrongNumArgs:
@@ -798,10 +804,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 2) {
- interp->result = (wmTracing) ? "on" : "off";
+ Tcl_SetResult(interp, ((dispPtr->wmTracing) ? "on" : "off"),
+ TCL_STATIC);
return TCL_OK;
}
- return Tcl_GetBoolean(interp, argv[2], &wmTracing);
+ return Tcl_GetBoolean(interp, argv[2], &dispPtr->wmTracing);
}
if (argc < 3) {
@@ -828,9 +835,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
+ 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;
}
@@ -845,7 +855,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- interp->result = "aspect number can't be <= 0";
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -866,7 +877,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->clientMachine != NULL) {
- interp->result = wmPtr->clientMachine;
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
}
return TCL_OK;
}
@@ -890,12 +901,16 @@ Tk_WmCmd(clientData, interp, argc, argv)
strcpy(wmPtr->clientMachine, argv[3]);
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
XTextProperty textProp;
- if (XStringListToTextProperty(&wmPtr->clientMachine, 1, &textProp)
- != 0) {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->clientMachine, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
+ &textProp) != 0) {
XSetWMClientMachine(winPtr->display, wmPtr->wrapperPtr->window,
&textProp);
XFree((char *) textProp.value);
}
+ Tcl_DStringFree(&ds);
}
} else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0)
&& (length >= 3)) {
@@ -985,8 +1000,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->cmdArgv != NULL) {
- interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- interp->freeProc = TCL_DYNAMIC;
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
}
return TCL_OK;
}
@@ -1010,8 +1026,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
wmPtr->cmdArgc = cmdArgc;
wmPtr->cmdArgv = cmdArgv;
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
- XSetCommand(winPtr->display, wmPtr->wrapperPtr->window,
- cmdArgv, cmdArgc);
+ UpdateCommand(winPtr);
}
} else if ((c == 'd') && (strncmp(argv[1], "deiconify", length) == 0)) {
if (argc != 3) {
@@ -1041,7 +1056,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = wmPtr->hints.input ? "passive" : "active";
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
return TCL_OK;
}
c = argv[3][0];
@@ -1059,6 +1075,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
} else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
&& (length >= 2)) {
Window window;
+ char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
@@ -1069,7 +1086,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
if (window == None) {
window = Tk_WindowId((Tk_Window) winPtr);
}
- sprintf(interp->result, "0x%x", (unsigned int) window);
+ sprintf(buf, "0x%x", (unsigned int) window);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
&& (length >= 2)) {
char xSign, ySign;
@@ -1082,6 +1100,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
if (wmPtr->gridWin != NULL) {
@@ -1093,8 +1113,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
width = winPtr->changes.width;
height = winPtr->changes.height;
}
- sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
- xSign, wmPtr->x, ySign, wmPtr->y);
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if (*argv[3] == '\0') {
@@ -1115,9 +1136,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
+ 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;
}
@@ -1144,19 +1168,19 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (reqWidth < 0) {
- interp->result = "baseWidth can't be < 0";
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (reqHeight < 0) {
- interp->result = "baseHeight can't be < 0";
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (widthInc < 0) {
- interp->result = "widthInc can't be < 0";
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (heightInc < 0) {
- interp->result = "heightInc can't be < 0";
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
@@ -1177,7 +1201,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & WindowGroupHint) {
- interp->result = wmPtr->leaderName;
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
}
return TCL_OK;
}
@@ -1204,6 +1228,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
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) (strlen(argv[3])+1));
@@ -1222,8 +1249,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPixmapHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_pixmap);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1277,8 +1305,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
} else {
if (XIconifyWindow(winPtr->display, wmPtr->wrapperPtr->window,
winPtr->screenNum) == 0) {
- interp->result =
- "couldn't send iconify message to window manager";
+ Tcl_SetResult(interp,
+ "couldn't send iconify message to window manager",
+ TCL_STATIC);
return TCL_ERROR;
}
WaitForMapNotify(winPtr, 0);
@@ -1295,8 +1324,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_mask);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1322,17 +1352,23 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
return TCL_OK;
} else {
if (wmPtr->iconName != NULL) {
- ckfree(wmPtr->iconName);
+ ckfree((char *) wmPtr->iconName);
}
wmPtr->iconName = ckalloc((unsigned) (strlen(argv[3]) + 1));
strcpy(wmPtr->iconName, argv[3]);
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
XSetIconName(winPtr->display, wmPtr->wrapperPtr->window,
- wmPtr->iconName);
+ Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
}
}
} else if ((c == 'i') && (strncmp(argv[1], "iconposition", length) == 0)
@@ -1347,8 +1383,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
+ 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;
}
@@ -1378,7 +1417,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->icon != NULL) {
- interp->result = Tk_PathName(wmPtr->icon);
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
}
return TCL_OK;
}
@@ -1447,8 +1486,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
if (XWithdrawWindow(Tk_Display(tkwin2),
Tk_WindowId(wmPtr2->wrapperPtr),
Tk_ScreenNumber(tkwin2)) == 0) {
- interp->result =
- "couldn't send withdraw message to window manager";
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
return TCL_ERROR;
}
WaitForMapNotify((TkWindow *) tkwin2, 0);
@@ -1464,8 +1504,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
GetMaxSize(wmPtr, &width, &height);
- sprintf(interp->result, "%d %d", width, height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1485,8 +1528,10 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d", wmPtr->minWidth,
- wmPtr->minHeight);
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d", wmPtr->minWidth, wmPtr->minHeight);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1499,7 +1544,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
goto updateGeom;
} else if ((c == 'o')
&& (strncmp(argv[1], "overrideredirect", length) == 0)) {
- int boolean;
+ int boolean, curValue;
XSetWindowAttributes atts;
if ((argc != 3) && (argc != 4)) {
@@ -1508,24 +1553,27 @@ Tk_WmCmd(clientData, interp, argc, argv)
(char *) NULL);
return TCL_ERROR;
}
+ curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
if (argc == 3) {
- if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- interp->result = "1";
- } else {
- interp->result = "0";
- }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
return TCL_OK;
}
if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
return TCL_ERROR;
}
- atts.override_redirect = (boolean) ? True : False;
- Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
- &atts);
- if (winPtr->wmInfoPtr->wrapperPtr != NULL) {
- Tk_ChangeWindowAttributes(
+ 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);
+ }
}
} else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0)
&& (length >= 2)) {
@@ -1537,9 +1585,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USPosition) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PPosition) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1593,7 +1641,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- interp->result = protPtr->command;
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
return TCL_OK;
}
}
@@ -1640,9 +1688,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d",
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
@@ -1671,9 +1722,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USSize) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PSize) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1699,21 +1750,95 @@ Tk_WmCmd(clientData, interp, argc, argv)
goto updateGeom;
} else if ((c == 's') && (strncmp(argv[1], "state", length) == 0)
&& (length >= 2)) {
- if (argc != 3) {
+ if ((argc < 3) || (argc > 4)) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
- argv[0], " state window\"", (char *) NULL);
+ argv[0], " state window ?state?\"", (char *) NULL);
return TCL_ERROR;
}
- if (wmPtr->iconFor != NULL) {
- interp->result = "icon";
- } else if (wmPtr->withdrawn) {
- interp->result = "withdrawn";
- } else if (Tk_IsMapped((Tk_Window) winPtr)
- || ((wmPtr->flags & WM_NEVER_MAPPED)
- && (wmPtr->hints.initial_state == NormalState))) {
- interp->result = "normal";
+ if (argc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = argv[3][0];
+ length = strlen(argv[3]);
+
+ if ((c == 'n') && (strncmp(argv[3], "normal", length) == 0)) {
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->withdrawn = 0;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return TCL_OK;
+ }
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ } else if ((c == 'i')
+ && (strncmp(argv[3], "iconic", length) == 0)) {
+ 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;
+ }
+ wmPtr->hints.initial_state = IconicState;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return TCL_OK;
+ }
+ if (wmPtr->withdrawn) {
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ wmPtr->withdrawn = 0;
+ } else {
+ if (XIconifyWindow(winPtr->display,
+ wmPtr->wrapperPtr->window,
+ winPtr->screenNum) == 0) {
+ Tcl_SetResult(interp, "couldn't send iconify message to window manager", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ WaitForMapNotify(winPtr, 0);
+ }
+ } else if ((c == 'w')
+ && (strncmp(argv[3], "withdrawn", length) == 0)) {
+ wmPtr->hints.initial_state = WithdrawnState;
+ wmPtr->withdrawn = 1;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return TCL_OK;
+ }
+ if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ winPtr->screenNum) == 0) {
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ WaitForMapNotify(winPtr, 0);
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be normal, iconic or withdrawn",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
} else {
- interp->result = "iconic";
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else if (wmPtr->withdrawn) {
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ } else if (Tk_IsMapped((Tk_Window) winPtr)
+ || ((wmPtr->flags & WM_NEVER_MAPPED)
+ && (wmPtr->hints.initial_state == NormalState))) {
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ }
}
} else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
&& (length >= 2)) {
@@ -1723,24 +1848,28 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->title != NULL) ? wmPtr->title
- : winPtr->nameUid;
+ Tcl_SetResult(interp,
+ ((wmPtr->title != NULL) ? wmPtr->title : winPtr->nameUid),
+ TCL_STATIC);
return TCL_OK;
} else {
if (wmPtr->title != NULL) {
- ckfree(wmPtr->title);
+ ckfree((char *) wmPtr->title);
}
wmPtr->title = ckalloc((unsigned) (strlen(argv[3]) + 1));
strcpy(wmPtr->title, argv[3]);
if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
XTextProperty textProp;
+ Tcl_DString ds;
- if (XStringListToTextProperty(&wmPtr->title, 1,
+ Tcl_UtfToExternalDString(NULL, wmPtr->title, -1, &ds);
+ if (XStringListToTextProperty(&(Tcl_DStringValue(&ds)), 1,
&textProp) != 0) {
XSetWMName(winPtr->display, wmPtr->wrapperPtr->window,
&textProp);
XFree((char *) textProp.value);
}
+ Tcl_DStringFree(&ds);
}
}
} else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
@@ -1755,7 +1884,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->master != None) {
- interp->result = wmPtr->masterWindowName;
+ Tcl_SetResult(interp, wmPtr->masterWindowName, TCL_STATIC);
}
return TCL_OK;
}
@@ -1783,6 +1912,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
CreateWrapper(wmPtr2);
}
wmPtr->master = Tk_WindowId(wmPtr2->wrapperPtr);
+ if (wmPtr->masterWindowName != NULL) {
+ ckfree((char *) wmPtr->masterWindowName);
+ }
wmPtr->masterWindowName = ckalloc((unsigned) (strlen(argv[3])+1));
strcpy(wmPtr->masterWindowName, argv[3]);
}
@@ -1810,8 +1942,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (XWithdrawWindow(winPtr->display, wmPtr->wrapperPtr->window,
winPtr->screenNum) == 0) {
- interp->result =
- "couldn't send withdraw message to window manager";
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
return TCL_ERROR;
}
WaitForMapNotify(winPtr, 0);
@@ -2029,6 +2162,8 @@ ConfigureEvent(wmPtr, configEventPtr)
{
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
@@ -2046,7 +2181,7 @@ ConfigureEvent(wmPtr, configEventPtr)
if (((wrapperPtr->changes.width != configEventPtr->width)
|| (wrapperPtr->changes.height != configEventPtr->height))
&& !(wmPtr->flags & WM_SYNC_PENDING)){
- if (wmTracing) {
+ if (dispPtr->wmTracing) {
printf("TopLevelEventProc: user changed %s size to %dx%d\n",
winPtr->pathName, configEventPtr->width,
configEventPtr->height);
@@ -2110,7 +2245,7 @@ ConfigureEvent(wmPtr, configEventPtr)
wmPtr->configHeight = configEventPtr->height;
}
- if (wmTracing) {
+ if (dispPtr->wmTracing) {
printf("ConfigureEvent: %s x = %d y = %d, width = %d, height = %d",
winPtr->pathName, configEventPtr->x, configEventPtr->y,
configEventPtr->width, configEventPtr->height);
@@ -2156,12 +2291,15 @@ ConfigureEvent(wmPtr, configEventPtr)
/*
* Make sure that the toplevel and menubar are properly positioned within
- * the wrapper.
+ * 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))) {
@@ -2213,6 +2351,7 @@ ReparentEvent(wmPtr, reparentEventPtr)
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
@@ -2238,7 +2377,7 @@ ReparentEvent(wmPtr, reparentEventPtr)
&& (actualType == XA_WINDOW))) {
if ((actualFormat == 32) && (numItems == 1)) {
vRoot = wmPtr->vRoot = *virtualRootPtr;
- } else if (wmTracing) {
+ } else if (dispPtr->wmTracing) {
printf("%s format %d numItems %ld\n",
"ReparentEvent got bogus VROOT property:", actualFormat,
numItems);
@@ -2247,7 +2386,7 @@ ReparentEvent(wmPtr, reparentEventPtr)
}
Tk_DeleteErrorHandler(handler);
- if (wmTracing) {
+ if (dispPtr->wmTracing) {
printf("ReparentEvent: %s reparented to 0x%x, vRoot = 0x%x\n",
wmPtr->winPtr->pathName,
(unsigned int) reparentEventPtr->parent, (unsigned int) vRoot);
@@ -2344,6 +2483,7 @@ ComputeReparentGeometry(wmPtr)
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);
@@ -2410,7 +2550,7 @@ ComputeReparentGeometry(wmPtr)
wmPtr->wrapperPtr->changes.x = x + wmPtr->xInParent;
wmPtr->wrapperPtr->changes.y = y + wmPtr->yInParent;
- if (wmTracing) {
+ if (dispPtr->wmTracing) {
printf("wrapperPtr coords %d,%d, wmPtr coords %d,%d, offsets %d %d\n",
wrapperPtr->changes.x, wrapperPtr->changes.y,
wmPtr->x, wmPtr->y, wmPtr->xInParent, wmPtr->yInParent);
@@ -2443,6 +2583,7 @@ WrapperEventProc(clientData, eventPtr)
{
WmInfo *wmPtr = (WmInfo *) clientData;
XEvent mapEvent;
+ TkDisplay *dispPtr = wmPtr->winPtr->dispPtr;
wmPtr->flags |= WM_VROOT_OFFSET_STALE;
if (eventPtr->type == DestroyNotify) {
@@ -2462,7 +2603,7 @@ WrapperEventProc(clientData, eventPtr)
Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
Tk_DeleteErrorHandler(handler);
}
- if (wmTracing) {
+ if (dispPtr->wmTracing) {
printf("TopLevelEventProc: %s deleted\n", wmPtr->winPtr->pathName);
}
} else if (eventPtr->type == ConfigureNotify) {
@@ -2725,7 +2866,7 @@ UpdateGeometryInfo(clientData)
}
wmPtr->configWidth = width;
wmPtr->configHeight = height;
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n",
x, y, width, height);
}
@@ -2746,7 +2887,7 @@ UpdateGeometryInfo(clientData)
}
wmPtr->configWidth = width;
wmPtr->configHeight = height;
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("UpdateGeometryInfo resizing to %d x %d\n", width, height);
}
XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window,
@@ -2947,7 +3088,7 @@ WaitForConfigureNotify(winPtr, serial)
ConfigureNotify, &event);
wmPtr->flags &= ~WM_SYNC_PENDING;
if (code != TCL_OK) {
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("WaitForConfigureNotify giving up on %s\n",
winPtr->pathName);
}
@@ -2959,7 +3100,7 @@ WaitForConfigureNotify(winPtr, serial)
}
}
wmPtr->flags &= ~WM_MOVE_PENDING;
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("WaitForConfigureNotify finished with %s, serial %ld\n",
winPtr->pathName, serial);
}
@@ -3135,14 +3276,14 @@ WaitForMapNotify(winPtr, mapped)
* just quit.
*/
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("WaitForMapNotify giving up on %s\n", winPtr->pathName);
}
break;
}
}
wmPtr->flags &= ~WM_MOVE_PENDING;
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("WaitForMapNotify finished with %s\n", winPtr->pathName);
}
}
@@ -3188,7 +3329,7 @@ UpdateHints(winPtr)
*
* Results:
* A standard Tcl return value, plus an error message in
- * interp->result if an error occurs.
+ * the interp's result if an error occurs.
*
* Side effects:
* The size and/or location of winPtr may change.
@@ -3441,6 +3582,8 @@ Tk_CoordsToWindow(rootX, rootY, tkwin)
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
@@ -3452,7 +3595,7 @@ Tk_CoordsToWindow(rootX, rootY, tkwin)
parent = window = RootWindowOfScreen(Tk_Screen(tkwin));
x = rootX;
y = rootY;
- for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
+ for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
if (Tk_Screen(wmPtr->winPtr) != Tk_Screen(tkwin)) {
continue;
}
@@ -3479,15 +3622,24 @@ Tk_CoordsToWindow(rootX, rootY, tkwin)
* 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) {
- panic("Tk_CoordsToWindow got False return from XTranslateCoordinates");
+ /*
+ * 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 = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
+ for (wmPtr = (WmInfo *) dispPtr->firstWmPtr; wmPtr != NULL;
+ wmPtr = wmPtr->nextPtr) {
if (wmPtr->reparent == child) {
goto gotToplevel;
}
@@ -3506,6 +3658,14 @@ Tk_CoordsToWindow(rootX, rootY, tkwin)
}
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;
@@ -3644,7 +3804,7 @@ UpdateVRootGeometry(wmPtr)
(unsigned int *) &wmPtr->vRootWidth,
(unsigned int *) &wmPtr->vRootHeight, (unsigned int *) &bd,
&dummy);
- if (wmTracing) {
+ if (winPtr->dispPtr->wmTracing) {
printf("UpdateVRootGeometry: x = %d, y = %d, width = %d, ",
wmPtr->vRootX, wmPtr->vRootY, wmPtr->vRootWidth);
printf("height = %d, status = %d\n", wmPtr->vRootHeight, status);
@@ -4818,3 +4978,63 @@ TkpGetWrapperWindow(winPtr)
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);
+}
diff --git a/tk/unix/tkUnixXId.c b/tk/unix/tkUnixXId.c
index dfe8b1935f8..134e47dfaff 100644
--- a/tk/unix/tkUnixXId.c
+++ b/tk/unix/tkUnixXId.c
@@ -12,7 +12,7 @@
* George C. Kaplan and Michael Hoegeman.
*
* Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ * 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.
@@ -28,9 +28,8 @@
#define XLIB_ILLEGAL_ACCESS 1
-#include "tkInt.h"
-#include "tkPort.h"
#include "tkUnixInt.h"
+#include "tkPort.h"
/*
* A structure of the following type is used to hold one or more
@@ -70,7 +69,7 @@ static void WindowIdCleanup2 _ANSI_ARGS_((ClientData clientData));
* None.
*
* Side effects:
- * The official allocator for the display is set up to be Tk_AllocXID.
+ * The official allocator for the display is set up to be AllocXId.
*
*----------------------------------------------------------------------
*/
@@ -535,3 +534,4 @@ TkpWindowWasRecentlyDeleted(win, dispPtr)
}
return 0;
}
+
diff --git a/tk/win/Makefile.in b/tk/win/Makefile.in
index 272627eeeb9..7af644ea916 100644
--- a/tk/win/Makefile.in
+++ b/tk/win/Makefile.in
@@ -1,446 +1,478 @@
-# Visual C++ 2.x and 4.0 makefile
+# This file is a Makefile for Tk. If it has the name "Makefile.in"
+# then it is a template for a Makefile; to generate the actual Makefile,
+# run "./configure", which is a configuration script generated by the
+# "autoconf" program (constructs like "@foo@" will get replaced in the
+# actual Makefile.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# SCCS: @(#) makefile.vc 1.63 97/08/13 13:33:32
-
-# Does not depend on the presence of any environment variables in
-# order to compile tcl; all needed information is derived from
-# location of the compiler directories.
-
-# This file is CYGNUS LOCAL. It is a copy of makefile.vc from the
-# standard tk distribution, modified to work with cygwin and an
-# autoconf configure script. I have chosen to minimize the number of
-# changes, so the comments continue to refer to Visual C++ and the
-# like. This should make it easier to merge in a new version if that
-# is necessary.
-
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-VPATH = @srcdir@:@srcdir@/../xlib:@srcdir@/../generic:@srcdir@/../unix:@srcdir@/../win/rc
-srcdir = @srcdir@
-
-INSTALL = @INSTALL@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-
-CC = @CC@
-CFLAGS = @CFLAGS@
-NM = @NM@
-AS = @AS@
-LD = @LD@
-DLLTOOL = @DLLTOOL@
-WINDRES = @WINDRES@
-
-OBJEXT=@OBJEXT@
-
-DLL_LDFLAGS = @DLL_LDFLAGS@
-DLL_LDLIBS = @DLL_LDLIBS@
-
-# Current Tk version; used in various names.
-
-DIRVERSION = @TK_VERSION@
+# RCS: @(#) $Id$
+
+TCLVERSION = @TCL_VERSION@
+VERSION = @TK_VERSION@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+bindir = @bindir@
+libdir = @libdir@
+includedir = @includedir@
+mandir = @mandir@
# The following definition can be set to non-null for special systems
# like AFS with replication. It allows the pathnames used for installation
# to be different than those used for actually reference files at
# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
# when installing files.
-INSTALL_ROOT =
+INSTALL_ROOT =
-# Directory from which applications will reference the library of Tcl
+# 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 the compiled-in location):
-TK_LIBRARY = @datadir@/tk$(DIRVERSION)
+# run-time to override this value):
+TK_LIBRARY = @datadir@/tk$(VERSION)
-# Path name to use when installing library scripts:
-SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = $(libdir)
+
+# Directory in which to install the program wish:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(bindir)
# Directory in which to install the .a or .so binary for the Tk library:
-LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
-# Directory in which to install the program wish:
-BIN_INSTALL_DIR = $(INSTALL_ROOT)@bindir@
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
# Directory in which to install the include file tk.h:
-INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)
+
+# Top-level directory for manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(mandir)
-# Directory in which to install the X11 header files. These files are
-# not machine independent, so they should not go in includedir.
-X11_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@exec_prefix@/@host_alias@/include/X11
+# Directory in which to install manual entry for wish:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for Tk's C library
+# procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tk commands:
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+
+# Libraries built with optimization switches have this additional extension
+TK_DBGX = @TK_DBGX@
+
+# The directory containing the Tcl source and header files.
+TCL_SRC_DIR = @TCL_SRC_DIR@
+
+# The directory containing the Tcl library archive file appropriate
+# for this version of Tk:
+TCL_BIN_DIR = @TCL_BIN_DIR@
+
+# 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
+
+# This program converts from POSIX to Windows native paths.
+CYGPATH = @CYGPATH@
+
+# The name of the Tcl library.
+TCL_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
+TCL_STUB_LIB_SPEC = @TCL_BUILD_STUB_LIB_SPEC@
+
+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)')
+TCL_BIN_DIR_NATIVE = $(shell $(CYGPATH) '$(TCL_BIN_DIR)')
+RC_DIR_NATIVE = $(shell $(CYGPATH) '$(RC_DIR)')
+
+DLLSUFFIX = @DLLSUFFIX@
+LIBSUFFIX = @LIBSUFFIX@
+EXESUFFIX = @EXESUFFIX@
+
+TK_STUB_LIB_FILE = @TK_STUB_LIB_FILE@
+TK_LIB_FILE = @TK_LIB_FILE@
+TK_DLL_FILE = @TK_DLL_FILE@
+
+SHARED_LIBRARIES = $(TK_DLL_FILE) $(TK_STUB_LIB_FILE)
+STATIC_LIBRARIES = $(TK_LIB_FILE)
+
+WISH_RES = @WISH_RES@
+TK_RES = @TK_RES@
+
+WISH = wish$(VER)${EXESUFFIX}
+TKTEST = tktest${EXEEXT}
+CAT32 = cat32$(EXEEXT)
+MAN2TCL = man2tcl$(EXEEXT)
+
+@SET_MAKE@
+
+# Setting the VPATH variable to a list of paths will cause the
+# makefile to look into these paths when resolving .c to .obj
+# dependencies.
+
+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@
+AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@ @LDFLAGS_DEFAULT@
+LDFLAGS_CONSOLE = @LDFLAGS_CONSOLE@
+LDFLAGS_WINDOW = @LDFLAGS_WINDOW@
+EXEEXT = @EXEEXT@
+OBJEXT = @OBJEXT@
+LIBS_GUI = @LIBS_GUI@
+STLIB_LD = @STLIB_LD@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ $(TCL_STUB_LIB_SPEC) $(LIBS_GUI)
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+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
+
+# FIXME: Add a "make shell SCRIPT=foo.tcl" argument
+# so that a shell can easily be run from the build dir.
+TCLSH_PROG = $(TCL_BIN_DIR)/tclsh$(VER)
+
+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 = ${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)
+
+TCLTEST_OBJS = \
+ ${TCL_BIN_DIR}/tclThreadTest.$(OBJEXT)
+
+TCLTEST_OBJS_NATIVE = \
+ "${TCL_BIN_DIR_NATIVE}/tclThreadTest.$(OBJEXT)"
+
+TKTEST_OBJS = \
+ $(TCLTEST_OBJS) \
+ testMain.$(OBJEXT) \
+ tkSquare.$(OBJEXT) \
+ tkTest.$(OBJEXT) \
+ tkWinTest.$(OBJEXT)
+
+TKTEST_OBJS_NATIVE = \
+ $(TCLTEST_OBJS_NATIVE) \
+ 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) \
+ tkObj.$(OBJEXT) \
+ tkOldConfig.$(OBJEXT) \
+ tkOption.$(OBJEXT) \
+ tkPack.$(OBJEXT) \
+ tkPlace.$(OBJEXT) \
+ tkPointer.$(OBJEXT) \
+ tkRectOval.$(OBJEXT) \
+ tkScale.$(OBJEXT) \
+ tkScrollbar.$(OBJEXT) \
+ tkSelect.$(OBJEXT) \
+ tkText.$(OBJEXT) \
+ tkTextBTree.$(OBJEXT) \
+ tkTextDisp.$(OBJEXT) \
+ tkTextImage.$(OBJEXT) \
+ tkTextIndex.$(OBJEXT) \
+ tkTextMark.$(OBJEXT) \
+ tkTextTag.$(OBJEXT) \
+ tkTextWind.$(OBJEXT) \
+ tkTrig.$(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
-#
-# Project directories
-#
-# ROOT = top of source tree
-#
-# TMPDIR = location where .obj files should be stored during build
-#
-# TOOLS32 = location of VC++ 32-bit development tools. Note that the
-# VC++ 2.0 header files are broken, so you need to use the
-# ones that come with the developer network CD's, or later
-# versions of VC++.
-#
-# TCLDIR = location of top of Tcl source heirarchy
-#
+# Main targets. The default target -- all -- builds the binaries,
+# performs any post processing on libraries or documents.
+
+all: binaries libraries doc
+
+binaries: @LIBRARIES@ $(WISH)
+
+libraries:
+
+$(ROOT_DIR)/doc/man.macros:
+ $(INSTALL_DATA) @TCL_SRC_DIR@/doc/man.macros $(ROOT_DIR)/doc/man.macros
+
+doc: $(ROOT_DIR)/doc/man.macros
-ROOT = $(srcdir)/..
-TMPDIR = .
-TOOLS32 = c:\msdev
-TCLDIR = $(srcdir)/../../tcl
-
-# Set this to the appropriate value of /MACHINE: for your platform
-MACHINE = IX86
-
-# Comment the following line to compile with symbols
-NODEBUG=1
-
-# uncomment the following two lines to compile with TCL_MEM_DEBUG
-#DEBUGDEFINES =-DTCL_MEM_DEBUG
-
-######################################################################
-# Do not modify below this line
-######################################################################
-
-VERSION = 80
-
-TCLDLL = cygtcl$(VERSION).dll
-TCLLIB = libtcl$(VERSION).a
-TCLPLUGINDLL = cygtcl$(VERSION)p.dll
-TCLPLUGINLIB = libtcl$(VERSION)p.a
-TKDLL = cygtk$(VERSION).dll
-TKLIB = libtk$(VERSION).a
-TKPLUGINDLL = cygtk$(VERSION)p.dll
-TKPLUGINLIB = libtk$(VERSION)p.a
-
-WISH = cygwish$(VERSION).exe
-WISHP = cygwishp$(VERSION).exe
-TKTEST = tktest.exe
-DUMPEXTS = $(TMPDIR)/dumpexts.exe
-
-WISHOBJS = \
- $(TMPDIR)/tkConsole.$(OBJEXT) \
- $(TMPDIR)/winMain.$(OBJEXT)
-
-TKTESTOBJS = \
- $(TMPDIR)/tkConsole.$(OBJEXT) \
- $(TMPDIR)/tkTest.$(OBJEXT) \
- $(TMPDIR)/tkSquare.$(OBJEXT) \
- $(TMPDIR)/testMain.$(OBJEXT)
-
-XLIBOBJS = \
- $(TMPDIR)/xcolors.$(OBJEXT) \
- $(TMPDIR)/xdraw.$(OBJEXT) \
- $(TMPDIR)/xgc.$(OBJEXT) \
- $(TMPDIR)/ximage.$(OBJEXT) \
- $(TMPDIR)/xutil.$(OBJEXT)
-
-TKOBJS = \
- $(TMPDIR)/tkUnixMenubu.$(OBJEXT) \
- $(TMPDIR)/tkUnixScale.$(OBJEXT) \
- $(XLIBOBJS) \
- $(TMPDIR)/tkWin3d.$(OBJEXT) \
- $(TMPDIR)/tkWin32Dll.$(OBJEXT) \
- $(TMPDIR)/tkWinButton.$(OBJEXT) \
- $(TMPDIR)/tkWinClipboard.$(OBJEXT) \
- $(TMPDIR)/tkWinColor.$(OBJEXT) \
- $(TMPDIR)/tkWinCursor.$(OBJEXT) \
- $(TMPDIR)/tkWinDialog.$(OBJEXT) \
- $(TMPDIR)/tkWinDraw.$(OBJEXT) \
- $(TMPDIR)/tkWinEmbed.$(OBJEXT) \
- $(TMPDIR)/tkWinFont.$(OBJEXT) \
- $(TMPDIR)/tkWinImage.$(OBJEXT) \
- $(TMPDIR)/tkWinInit.$(OBJEXT) \
- $(TMPDIR)/tkWinKey.$(OBJEXT) \
- $(TMPDIR)/tkWinMenu.$(OBJEXT) \
- $(TMPDIR)/tkWinPixmap.$(OBJEXT) \
- $(TMPDIR)/tkWinPointer.$(OBJEXT) \
- $(TMPDIR)/tkWinRegion.$(OBJEXT) \
- $(TMPDIR)/tkWinScrlbr.$(OBJEXT) \
- $(TMPDIR)/tkWinSend.$(OBJEXT) \
- $(TMPDIR)/tkWinWindow.$(OBJEXT) \
- $(TMPDIR)/tkWinWm.$(OBJEXT) \
- $(TMPDIR)/tkWinX.$(OBJEXT) \
- $(TMPDIR)/stubs.$(OBJEXT) \
- $(TMPDIR)/tk3d.$(OBJEXT) \
- $(TMPDIR)/tkArgv.$(OBJEXT) \
- $(TMPDIR)/tkAtom.$(OBJEXT) \
- $(TMPDIR)/tkBind.$(OBJEXT) \
- $(TMPDIR)/tkBitmap.$(OBJEXT) \
- $(TMPDIR)/tkButton.$(OBJEXT) \
- $(TMPDIR)/tkCanvArc.$(OBJEXT) \
- $(TMPDIR)/tkCanvBmap.$(OBJEXT) \
- $(TMPDIR)/tkCanvImg.$(OBJEXT) \
- $(TMPDIR)/tkCanvLine.$(OBJEXT) \
- $(TMPDIR)/tkCanvPoly.$(OBJEXT) \
- $(TMPDIR)/tkCanvPs.$(OBJEXT) \
- $(TMPDIR)/tkCanvText.$(OBJEXT) \
- $(TMPDIR)/tkCanvUtil.$(OBJEXT) \
- $(TMPDIR)/tkCanvWind.$(OBJEXT) \
- $(TMPDIR)/tkCanvas.$(OBJEXT) \
- $(TMPDIR)/tkClipboard.$(OBJEXT) \
- $(TMPDIR)/tkCmds.$(OBJEXT) \
- $(TMPDIR)/tkColor.$(OBJEXT) \
- $(TMPDIR)/tkConfig.$(OBJEXT) \
- $(TMPDIR)/tkCursor.$(OBJEXT) \
- $(TMPDIR)/tkEntry.$(OBJEXT) \
- $(TMPDIR)/tkError.$(OBJEXT) \
- $(TMPDIR)/tkEvent.$(OBJEXT) \
- $(TMPDIR)/tkFileFilter.$(OBJEXT) \
- $(TMPDIR)/tkFocus.$(OBJEXT) \
- $(TMPDIR)/tkFont.$(OBJEXT) \
- $(TMPDIR)/tkFrame.$(OBJEXT) \
- $(TMPDIR)/tkGC.$(OBJEXT) \
- $(TMPDIR)/tkGeometry.$(OBJEXT) \
- $(TMPDIR)/tkGet.$(OBJEXT) \
- $(TMPDIR)/tkGrab.$(OBJEXT) \
- $(TMPDIR)/tkGrid.$(OBJEXT) \
- $(TMPDIR)/tkImage.$(OBJEXT) \
- $(TMPDIR)/tkImgBmap.$(OBJEXT) \
- $(TMPDIR)/tkImgGIF.$(OBJEXT) \
- $(TMPDIR)/tkImgPPM.$(OBJEXT) \
- $(TMPDIR)/tkImgPhoto.$(OBJEXT) \
- $(TMPDIR)/tkImgUtil.$(OBJEXT) \
- $(TMPDIR)/tkListbox.$(OBJEXT) \
- $(TMPDIR)/tkMacWinMenu.$(OBJEXT) \
- $(TMPDIR)/tkMain.$(OBJEXT) \
- $(TMPDIR)/tkMenu.$(OBJEXT) \
- $(TMPDIR)/tkMenubutton.$(OBJEXT) \
- $(TMPDIR)/tkMenuDraw.$(OBJEXT) \
- $(TMPDIR)/tkMessage.$(OBJEXT) \
- $(TMPDIR)/tkOption.$(OBJEXT) \
- $(TMPDIR)/tkPack.$(OBJEXT) \
- $(TMPDIR)/tkPlace.$(OBJEXT) \
- $(TMPDIR)/tkPointer.$(OBJEXT) \
- $(TMPDIR)/tkRectOval.$(OBJEXT) \
- $(TMPDIR)/tkScale.$(OBJEXT) \
- $(TMPDIR)/tkScrollbar.$(OBJEXT) \
- $(TMPDIR)/tkSelect.$(OBJEXT) \
- $(TMPDIR)/tkText.$(OBJEXT) \
- $(TMPDIR)/tkTextBTree.$(OBJEXT) \
- $(TMPDIR)/tkTextDisp.$(OBJEXT) \
- $(TMPDIR)/tkTextImage.$(OBJEXT) \
- $(TMPDIR)/tkTextIndex.$(OBJEXT) \
- $(TMPDIR)/tkTextMark.$(OBJEXT) \
- $(TMPDIR)/tkTextTag.$(OBJEXT) \
- $(TMPDIR)/tkTextWind.$(OBJEXT) \
- $(TMPDIR)/tkTrig.$(OBJEXT) \
- $(TMPDIR)/tkUtil.$(OBJEXT) \
- $(TMPDIR)/tkVisual.$(OBJEXT) \
- $(TMPDIR)/tkWindow.$(OBJEXT)
-
-cc32 = $(TOOLS32)\bin\cl.exe
-link32 = $(TOOLS32)\bin\link.exe
-rc32 = $(TOOLS32)\bin\rc.exe
-include32 = -I$(TOOLS32)\include
-
-WINDIR = $(ROOT)/win
-GENERICDIR = $(ROOT)/generic
-XLIBDIR = $(ROOT)/xlib
-BITMAPDIR = $(ROOT)/bitmaps
-TCLLIBDIR = ../../tcl/win
-RCDIR = $(WINDIR)/rc
-
-TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
- -I$(TCLDIR)/generic
-TK_DEFINES = $(DEBUGDEFINES)
-
-TK_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) \
- $(TK_INCLUDES) $(TK_DEFINES) $(CFLAGS)
-
-######################################################################
-# Link flags
-######################################################################
-
-#!IFDEF NODEBUG
-#ldebug = /RELEASE
-#!ELSE
-#ldebug = -debug:full -debugtype:cv
-#!ENDIF
-
-# declarations common to all linker options
-# lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
-
-# declarations for use on Intel i386, i486, and Pentium systems
-#!IF "$(MACHINE)" == "IX86"
-#DLLENTRY = @12
-#lflags = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
-#!ELSE
-#lflags = $(lcommon) /MACHINE:$(MACHINE)
-#!ENDIF
-
-ifeq ($(OBJEXT),obj)
-
-lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
-lflags = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
-conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
-guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
-dlllflags = $(lflags) -entry:_DllMainCRTStartup@12 -dll
-
-else
-
-conlflags = $(lflags) -Wl,--subsystem,console -mwindows
-guilflags = $(lflags) -mwindows
-dlllflags = $(lflags)
-
-endif
-
-#!IF "$(MACHINE)" == "PPC"
-#libc = libc.lib
-#libcdll = crtdll.lib
-#!ELSE
-#libc = libc.lib oldnames.lib
-#libcdll = msvcrt.lib oldnames.lib
-#!ENDIF
-
-ifeq ($(OBJEXT),o)
-
-baselibs = -lkernel32 $(optlibs) -ladvapi32
-winlibs = $(baselibs) -luser32 -lgdi32 -lcomdlg32 -lwinspool
-
-else
-
-baselibs = kernel32.lib $(optlibs) advapi32.lib
-winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
-libcdll = msvcrt.lib oldnames.lib
-
-endif
-
-guilibs = $(libc) $(winlibs)
-
-guilibsdll = $(libcdll) $(winlibs)
-
-######################################################################
-# Compile flags
-######################################################################
-
-#!IFDEF NODEBUG
-#cdebug = -Ox
-#!ELSE
-#cdebug = -Z7 -Od -WX
-#!ENDIF
-
-# declarations common to all compiler options
-#ccommon = -c -W3 -nologo -YX
-
-#!IF "$(MACHINE)" == "IX86"
-#cflags = $(ccommon) -D_X86_=1
-#!ELSE
-#!IF "$(MACHINE)" == "MIPS"
-#cflags = $(ccommon) -D_MIPS_=1
-#!ELSE
-#!IF "$(MACHINE)" == "PPC"
-#cflags = $(ccommon) -D_PPC_=1
-#!ELSE
-#!IF "$(MACHINE)" == "ALPHA"
-#cflags = $(ccommon) -D_ALPHA_=1
-#!ENDIF
-#!ENDIF
-#!ENDIF
-#!ENDIF
+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/
-cvars = -DWIN32 -D_WIN32
-cvarsmt = $(cvars) -D_MT
-cvarsdll = $(cvarsmt) -D_DLL
+$(MAN2TCL): $(TCL_SRC_DIR_NATIVE)/tools/man2tcl.c
+ $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(TCL_SRC_DIR_NATIVE)"/tools/man2tcl.c
-CON_CFLAGS = $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE
+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)
-######################################################################
-# Project specific targets
-######################################################################
-
-all: $(TKDLL) $(TKLIB) $(WISH)
-test: $(TKTEST)
-plugin: $(TKPLUGINDLL) $(WISHP)
-
-install: install-binaries install-libraries install-demos
+runtest: 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)
-install-binaries: $(TKDLL) $(TKLIB) $(WISH)
+install: all install-binaries install-libraries install-doc install-demos
+
+install-binaries:
@for i in $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR) ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ $(MKDIR) $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @echo "Installing $(TKLIB)"
- @$(INSTALL_DATA) $(TKLIB) $(LIB_INSTALL_DIR)/$(TKLIB)
- @chmod 555 $(LIB_INSTALL_DIR)/$(TKLIB)
- @echo "Installing wish"
+ @echo "Installing $(TK_LIB_FILE) to $(LIB_INSTALL_DIR)/"
+ @$(INSTALL_DATA) $(TK_LIB_FILE) $(LIB_INSTALL_DIR)/$(TK_LIB_FILE)
+ @echo "Installing $(WISH) as $(BIN_INSTALL_DIR)/wish$(VERSION)"
@$(INSTALL_PROGRAM) $(WISH) $(BIN_INSTALL_DIR)/$(WISH)
- @echo "Installing tkConfig.sh"
- @$(INSTALL_DATA) ../unix/tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
+ @echo "Installing tkConfig.sh to $(LIB_INSTALL_DIR)/"
+ @$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
+ @if test "$(DLLSUFFIX)" != "" ; then \
+ echo "Installing $(TK_DLL_FILE) to $(LIB_INSTALL_DIR)/" ; \
+ $(INSTALL_PROGRAM) $(TK_DLL_FILE) \
+ $(BIN_INSTALL_DIR)/$(TK_DLL_FILE) ; \
+ fi
+ @if test "$(TK_STUB_LIB_FILE)" != "" ; then \
+ if [ -f $(TK_STUB_LIB_FILE) ]; then \
+ echo "Installing $(TK_STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
+ $(INSTALL_DATA) $(TK_STUB_LIB_FILE) \
+ $(LIB_INSTALL_DIR)/$(TK_STUB_LIB_FILE); \
+ fi; \
+ fi
install-libraries:
- @echo "Installing DLL"
- @$(INSTALL_DATA) $(TKDLL) $(BIN_INSTALL_DIR)/$(TKDLL)
- @for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
- $(SCRIPT_INSTALL_DIR) $(INSTALL_ROOT)@exec_prefix@ \
- $(INSTALL_ROOT)@exec_prefix@/@host_alias@ \
- $(INSTALL_ROOT)@exec_prefix@/@host_alias@/include \
- $(X11_INCLUDE_INSTALL_DIR) ; \
+ @for i in $(INSTALL_ROOT)$(prefix)/lib \
+ $(INCLUDE_INSTALL_DIR) $(INCLUDE_INSTALL_DIR)/X11 \
+ $(SCRIPT_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)/images; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ $(MKDIR) $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @echo "Installing tk.h"
- @$(INSTALL_DATA) $(GENERICDIR)/tk.h $(INCLUDE_INSTALL_DIR)/tk.h
- for i in $(XLIBDIR)/X11/*.h; \
+ @echo "Installing header files";
+ @for i in $(GENERIC_DIR)/tk.h $(GENERIC_DIR)/tkDecls.h \
+ $(GENERIC_DIR)/tkIntXlibDecls.h ; \
do \
- echo "Installing $$i"; \
- $(INSTALL_DATA) $$i $(X11_INCLUDE_INSTALL_DIR); \
+ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR); \
done;
- for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(ROOT)/library/prolog.ps $(ROOT)/unix/tkAppInit.c; \
+ @for i in $(XLIB_DIR)/X11/*.h; \
do \
- echo "Installing $$i"; \
- $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ $(INSTALL_DATA) $$i $(INCLUDE_INSTALL_DIR)/X11; \
done;
-
-install-minimal:
- @echo "Installing DLL"
- @$(INSTALL_DATA) $(TKDLL) $(BIN_INSTALL_DIR)/$(TKDLL)
- @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) ; \
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
+ @for i in $(ROOT_DIR)/library/*.tcl $(GENERIC_DIR)/prolog.ps \
+ $(ROOT_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \
do \
- if [ ! -d $$i ] ; then \
- echo "Making directory $$i"; \
- mkdir $$i; \
- chmod 755 $$i; \
- else true; \
- fi; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
done;
- for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(ROOT)/library/prolog.ps; \
+ @echo "Installing library images directory";
+ @for i in $(ROOT_DIR)/library/images/*; \
do \
- echo "Installing $$i"; \
- $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ if [ -f $$i ] ; then \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/images; \
+ fi; \
done;
install-demos:
- @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) \
+ @for i in $(INSTALL_ROOT)$(prefix)/lib $(SCRIPT_INSTALL_DIR) \
$(SCRIPT_INSTALL_DIR)/demos \
$(SCRIPT_INSTALL_DIR)/demos/images ; \
do \
if [ ! -d $$i ] ; then \
echo "Making directory $$i"; \
- mkdir $$i; \
+ $(MKDIR) $$i; \
chmod 755 $$i; \
else true; \
fi; \
done;
- @for i in $(ROOT)/library/demos/*; \
+ @echo "Installing demos to $(SCRIPT_INSTALL_DIR)/demos/";
+ @for i in $(ROOT_DIR)/library/demos/*; \
do \
if [ -f $$i ] ; then \
- echo "Installing $$i"; \
- sed -e '3 s|exec wish|exec $(WISH)|' \
+ sed -e '3 s|exec $(WISH)|exec $(WISH)|' \
$$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \
fi; \
done;
@@ -448,199 +480,114 @@ install-demos:
do \
chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
done;
- @for i in $(ROOT)/library/demos/images/*; \
+ @echo "Installing demo images";
+ @for i in $(ROOT_DIR)/library/demos/images/*; \
do \
if [ -f $$i ] ; then \
- echo "Installing $$i"; \
$(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
fi; \
done;
-ifeq ($(OBJEXT),o)
+install-doc:
-$(TKDLL): $(TKOBJS) tkres.$(OBJEXT) tkcyg.def
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tk.base -o $(TKDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66300000
- $(DLLTOOL) --as=$(AS) --dllname $(TKDLL) --def $(TMPDIR)/tkcyg.def --base-file tk.base --output-exp tk.exp
- $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tk.base tk.exp -o $(TKDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66300000
- $(DLLTOOL) --as=$(AS) --dllname $(TKDLL) --def $(TMPDIR)/tkcyg.def --base-file tk.base --output-exp tk.exp
- $(CC) $(DLL_LDFLAGS) tk.exp -o $(TKDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66300000
-else
+$(WISH): $(TK_LIB_FILE) $(WISH_OBJS) $(WISH_RES)
+ $(CC) $(CFLAGS) $(WISH_OBJS) $(TCL_LIB_SPEC) $(TK_LIB_FILE) $(LIBS) \
+ $(WISH_RES) $(CC_EXENAME) $(LDFLAGS_WINDOW)
-$(TKDLL): $(TKOBJS) tkres.$(OBJEXT) tkcyg.def
- link $(ldebug) $(dlllflags) -def:tkcyg.def \
- -out:$@ tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) \
- $(guilibsdll) $(TKOBJS)
- mv cygtk80.lib libtk80.a
-endif
+tktest : $(TKTEST)
-ifeq ($(OBJEXT),o)
+$(TKTEST): $(TK_LIB_FILE) $(TKTEST_OBJS) $(WISH_RES) $(CAT32)
+ $(CC) $(CFLAGS) $(TKTEST_OBJS_NATIVE) $(TCL_LIB_SPEC) \
+ $(TK_LIB_FILE) $(LIBS) \
+ $(WISH_RES) $(CC_EXENAME) $(LDFLAGS_WINDOW)
-$(TKLIB): $(TMPDIR)/tkcyg.def
- $(DLLTOOL) --as=$(AS) --dllname $(TKDLL) --def $(TMPDIR)/tkcyg.def --output-lib $(TKLIB)
+cat32.${OBJEXT}: $(TCL_SRC_DIR)/win/cat.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-else
+$(CAT32): cat32.${OBJEXT}
+ $(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
-$(TKLIB): $(TKDLL)
+# WISH_RES
+$(RC_DIR)/wish_static.rc : $(RC_DIR)/wish.rc $(RC_DIR)/tk_base.rc
+ cat $(RC_DIR)/wish.rc $(RC_DIR)/tk_base.rc > $(RC_DIR)/wish_static.rc
-endif
+wish_static.$(RES) : $(RC_DIR)/wish_static.rc
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
-$(TKPLUGINLIB): $(TMPDIR)/plugin.def
- $(DLLTOOL) --as=$(AS) --dllname $(TKPLUGINDLL) --def $(TMPDIR)/plugin.def --output-lib $(TKPLUGINLIB)
-$(TKPLUGINDLL): $(TKOBJS) tkres.$(OBJEXT) $(TMPDIR)/plugin.def
- $(CC) $(DLL_LDFLAGS) -Wl,--base-file,tkplugin.base -o $(TKPLUGINDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
- $(DLLTOOL) --as=$(AS) --dllname $(TKPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tkplugin.base --output-exp tk.exp
- $(CC) $(DLL_LDFLAGS) -Wl,--base-file,tkplugin.base tk.exp -o $(TKPLUGINDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
- $(DLLTOOL) --as=$(AS) --dllname $(TKPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tkplugin.base --output-exp tk.exp
- $(CC) $(DLL_LDFLAGS) tk.exp -o $(TKPLUGINDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
+# TK_RES
+$(RC_DIR)/tk_dll.rc : $(RC_DIR)/tk.rc $(RC_DIR)/tk_base.rc
+ cat $(RC_DIR)/tk.rc $(RC_DIR)/tk_base.rc > $(RC_DIR)/tk_dll.rc
-ifeq ($(OBJEXT),o)
+tk_dll.$(RES) : $(RC_DIR)/tk_dll.rc
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
-$(WISH): $(WISHOBJS) wishres.$(OBJEXT) $(TKLIB)
- $(CC) $(ldebug) $(guilflags) $(WISHOBJS) wishres.$(OBJEXT) -o $@ \
- $(TKLIB) $(TCLLIBDIR)/$(TCLLIB) $(guilibsdll)
+# The following targets are configured by autoconf to generate either
+# a shared library or static library
-else
+${TK_STUB_LIB_FILE}: ${STUB_OBJS}
+ @$(RM) ${TK_STUB_LIB_FILE}
+ @MAKE_LIB@ ${STUB_OBJS}
+ @POST_MAKE_LIB@
-$(WISH): $(WISHOBJS) wishres.$(OBJEXT) $(TKLIB)
- link $(ldebug) $(guilflags) $(WISHOBJS) wishres.$(OBJEXT) -OUT:$@ \
- $(TKLIB) $(TCLLIBDIR)/$(TCLLIB) $(guilibsdll)
-endif
+${TK_DLL_FILE}: ${TK_OBJS} $(TK_RES)
+ @$(RM) ${TK_DLL_FILE}
+ @MAKE_DLL@ ${TK_OBJS} $(TK_RES) $(SHLIB_LD_LIBS)
-$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) wishres.$(OBJEXT)
- $(CC) $(ldebug) $(guilflags) $(WISHOBJS) wishres.$(OBJEXT) -o $@ \
- $(TKPLUGINLIB) $(TCLLIBDIR)/$(TCLPLUGINLIB) $(guilibsdll)
+${GNU_TK_LIB_FILE}: ${TK_DLL_FILE}
-$(TKTEST): $(TKTESTOBJS) wishres.$(OBJEXT) $(TKLIB)
- $(CC) $(ldebug) $(guilflags) $(TKTESTOBJS) wishres.$(OBJEXT) -o $@ \
- $(TKLIB) $(TCLLIBDIR)/$(TCLLIB) $(guilibsdll)
+${MSVC_TK_LIB_FILE}: ${TK_OBJS}
+ @$(RM) ${TK_LIB_FILE}
+ @MAKE_LIB@ ${TK_OBJS}
+ @POST_MAKE_LIB@
-ifeq ($(OBJEXT),o)
-tkcyg.def: $(TKOBJS)
- echo 'EXPORTS' > tmp.def
- for o in $(TKOBJS); do \
- $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
- done
- mv tmp.def $(TMPDIR)/tkcyg.def
+# Special case object file targets
-plugin.def: $(TKOBJS)
- echo 'EXPORTS' > tmp.def
- for o in $(TKOBJS); do \
- $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
- done
- mv tmp.def $(TMPDIR)/plugin.def
+winMain.$(OBJEXT): winMain.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-else
+testMain.$(OBJEXT): winMain.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ -DTK_TEST $(CC_OBJNAME)
-# Source-Navigator need the extra Symbols.
+tkTest.$(OBJEXT): tkTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-tkcyg.def: $(TKOBJS) $(DUMPEXTS)
- $(DUMPEXTS) -o tkcyg.def $(TKDLL) $(TKOBJS)
- echo " tkWindowType" >> tkcyg.def
- echo " tkArcType" >> tkcyg.def
- echo " tkBitmapType" >> tkcyg.def
- echo " tkOvalType" >> tkcyg.def
- echo " tkImageType" >> tkcyg.def
- echo " tkPolygonType" >> tkcyg.def
- echo " tkLineType" >> tkcyg.def
- echo " tkTextType" >> tkcyg.def
- echo " tkRectangleType" >> tkcyg.def
- echo " tkTextCharType" >> tkcyg.def
+tkWinTest.$(OBJEXT): tkWinTest.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
-plugin.def: $(TKOBJS) $(DUMPEXTS)
- $(DUMPEXTS) -o tkcyg.def $(TKDLL) $(TKOBJS)
+tkSquare.$(OBJEXT): tkSquare.c
+ $(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
+tclThreadTest.$(OBJEXT): $(TCL_BIN_DIR)/tclThreadTest.$(OBJEXT)
-$(DUMPEXTS): $(TCLDIR)/win/winDumpExts.c
- $(CC) $(TCLDIR)/win/winDumpExts.c user32.lib -link -OUT:$(DUMPEXTS)
+# Add the object extension to the implicit rules. By default .obj is not
+# automatically added.
-endif
+.SUFFIXES: .${OBJEXT}
+.SUFFIXES: .$(RES)
+.SUFFIXES: .rc
-#$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
-# $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
-# set LIB=$(TOOLS32)\lib
-# $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
-# $(TMPDIR)\winDumpExts.$(OBJEXT)bj
+# Implicit rule for all object files that will end up in the Tcl library
-#
-# Special case object file targets
-#
+.c.$(OBJEXT):
+ $(CC) -c $(STUB_CC_SWITCHES) -DBUILD_tk @DEPARG@ $(CC_OBJNAME)
-$(TMPDIR)/testMain.$(OBJEXT): $(ROOT)/win/winMain.c
- $(CC) -c $(TK_CFLAGS) -DTK_TEST -o $@ $?
+.rc.$(RES):
+ $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(TCL_GENERIC_NATIVE)" @RC_INCLUDE@ "$(RC_DIR_NATIVE)" @DEPARG@
-#
-# Implicit rules
-#
-.SUFFIXES: .S .c .o .obj .s
-.c.$(OBJEXT):
- $(CC) -c $(TK_CFLAGS) $<
-
-ifeq ($(OBJEXT),o)
-
-tkres.$(OBJEXT): $(ROOT)/win/rc/tk.rc
- $(WINDRES) --include $(ROOT)/win/rc --include $(ROOT)/generic --define VS_VERSION_INFO=1 $(ROOT)/win/rc/tk.rc tkres.$(OBJEXT)
-
-wishres.$(OBJEXT): $(ROOT)/win/rc/wish.rc
- $(WINDRES) --include $(ROOT)/win/rc --include $(ROOT)/generic --define VS_VERSION_INFO=1 $(ROOT)/win/rc/wish.rc wishres.$(OBJEXT)
-
-else
-
-tkres.$(OBJEXT): $(ROOT)/win/rc/tk.rc
- rc -i$(ROOT)/win/rc -i$(ROOT)/generic -dVS_VERSION_INFO=1 -fotkres.$(OBJEXT) $(ROOT)/win/rc/tk.rc
-
-wishres.$(OBJEXT): $(ROOT)/win/rc/wish.rc
- rc -i$(ROOT)/win/rc -i$(ROOT)/generic -dVS_VERSION_INFO=1 -fowishres.$(OBJEXT) $(ROOT)/win/rc/wish.rc
-
-endif
-
-#{$(ROOT)\win\rc}.rc{$(TMPDIR)}.res:
-# $(rc32) -fo $@ -r -i $(ROOT)\generic $<
-
-clean:
- rm -f *.exp *.a *.dll *.exe $(TMPDIR)/*.$(OBJEXT) *.res *.def
- rm -f tk.base tkplugin.base
-
-# dependencies
-
-$(TMPDIR)/tk.res: \
- $(RCDIR)/buttons.bmp \
- $(RCDIR)/cursor*.cur \
- $(RCDIR)/tk.ico
-
-$(GENERICDIR)/default.h: $(WINDIR)/tkWinDefault.h
-$(GENERICDIR)/tkButton.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkCanvas.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkEntry.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkFrame.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkListbox.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkMenubutton.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkMessage.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkScale.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkScrollbar.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkText.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/default.h
-$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/default.h
-
-$(GENERICDIR)/tkText.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextBTree.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextImage.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextMark.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/tkText.h
-$(GENERICDIR)/tkTextWind.c: $(GENERICDIR)/tkText.h
-
-$(GENERICDIR)/tkMacWinMenu.c: $(GENERICDIR)/tkMenu.h
-$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/tkMenu.h
-$(GENERICDIR)/tkMenuDraw.c: $(GENERICDIR)/tkMenu.h
-$(WINDIR)/tkWinMenu.c: $(GENERICDIR)/tkMenu.h
-
-Makefile: $(WINDIR)/Makefile.in config.status
- $(SHELL) config.status
-
-config.status: $(WINDIR)/configure
- ./config.status --recheck
+depend:
+
+cleanhelp:
+ $(RM) *.hlp *.cnt *.hpj *.GID *.rtf man2tcl${EXEEXT}
+
+clean: cleanhelp
+ $(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 tkConfig.sh
+
+Makefile: $(SRC_DIR)/Makefile.in
+ ./config.status
diff --git a/tk/win/README b/tk/win/README
index f0206a6f2f5..fe3790e478b 100644
--- a/tk/win/README
+++ b/tk/win/README
@@ -1,4 +1,4 @@
-Tk 8.0.4 for Windows
+Tk 8.3 for Windows
by Scott Stanton
Scriptics Corporation
@@ -6,117 +6,20 @@ scott.stanton@scriptics.com
RCS: @(#) $Id$
-1. Introduction
----------------
-
This is the directory where you configure and compile the Windows
version of Tk. This directory also contains source files for Tk
that are specific to Microsoft Windows. The rest of this file
contains information specific to the Windows version of Tk.
-2. Distribution notes
----------------------
-
-Tk 8.0 for Windows is distributed in binary form in addition to the
-common source release. The binary distribution is a self-extracting
-archive with a built-in installation script.
-
-Look for the binary release in the same location as the source release
-(ftp.scriptics.com:/pub/tcl/tcl8_0 or any of the mirror sites). For most users,
-the binary release will be much easier to install and use. You only
-need the source release if you plan to modify the core of Tcl, or if
-you need to compile with a different compiler. With the addition of
-the dynamic loading interface, it is no longer necessary to have the
-source distribution in order to build and use extensions.
-
-3. Compiling Tk
-----------------
-
-In order to compile Tk for Windows, you need the following items:
-
- Tcl 8.0 Source Distribution (plus any patches)
- Tk 8.0 Source Distribution (plus any patches)
-
- The latest Win32 SDK header files
-
- Borland C++ 4.5 or later (32-bit compiler)
- or
- Visual C++ 2.x or later
-
-In practice, 8.0.4 was built with Visual C++ 5.0
-
-In the "win" subdirectory of the source release, you will find two
-files called "makefile.bc" and "makefile.vc". These are the makefiles
-for the Borland and Visual C++ compilers respectively. You should
-copy the appropriate one to "makefile" and update the paths at the top
-of the file to reflect your system configuration. Now you can use
-"make" (or "nmake" for VC++) to build the tk libraries and the wish
-executable.
-
-In order to use the binaries generated by these makefiles, you will
-need to place the Tk script library files someplace where Tk can
-find them. Tk looks in one of two places for the library files:
-
- 1) The environment variable "TK_LIBRARY".
-
- 2) In the lib\tk8.0 directory under the Tcl installation directory
- as specified in the registry:
-
- For Windows NT & 95:
- HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.0
- Value Name is "Root"
-
- For Win32s:
- HKEY_CLASSES_ROOT\SOFTWARE\Scriptics\Tcl\8.0\
-
- 2) Relative to the directory containing the current .exe.
- Tk will look for a directory "..\lib\tk8.0" relative to the
- directory containing the currently running .exe.
-
-Note that in order to run wish80.exe, you must ensure that tcl80.dll,
-tclpip80.dll (plus tcl1680.dll under Win32s), and tk80.dll are on your
-path, in the system directory, or in the directory containing
-wish80.exe.
-
-4. Test suite
--------------
-
-The Windows version of Tk does not pass many of the tests in the test
-suite. This is primarily due to dependencies in the test suite on the
-size of particular X fonts, and other X related features as well as
-problems with "exec". We will be working to develop a more general
-test suite for Tk under Windows, but for now, you will not be able to
-pass many of the tests.
-
-5. Known Bugs
--------------
-
-Here is the current list of known bugs/missing features for the
-Windows beta version of Tk:
-
-- There is no support for custom cursors/application icons. The core
- set of X cursors is supported, although you cannot change their color.
-- Stippling of arcs isn't implemented yet.
-- Some "wm" functions don't map to Windows and aren't implemented;
- others should map, but just aren't implemented. The worst offenders
- are the icon manipulation routines.
-- Under Win32s, you can only start one instance of Wish at a time.
-- Color management on some displays doesn't work properly resulting in
- Tk switching to monochrome mode.
-- Tk seems to fail to draw anything on some Matrox Millenium cards.
-- Printing does not work for images (e.g. GIF) on a canvas.
-- Tk_dialog appears in the upper left corner. This is a symptom of a
- larger problem with "wm geometry" when applied to unmapped or
- iconified windows.
-- Some keys don't work on international keyboards.
-- PPM images are using the wrong translation mode for writing to
- files, resulting in CR/LF terminated PPM files.
-- Tk crashes if the display depth changes while it is running. Tk
- also doesn't consistently track changes in the system colors.
-
-If you have comments or bug reports for the Windows version of Tk,
-please direct them to:
+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.
-<bugs@scriptics.com>
+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.
-or post them to the newsgroup comp.lang.tcl.
+Information about compiling for windows is maintained at:
+ http://dev.scriptics.com/doc/howto/compile.html
diff --git a/tk/win/aclocal.m4 b/tk/win/aclocal.m4
new file mode 100644
index 00000000000..005783c4aae
--- /dev/null
+++ b/tk/win/aclocal.m4
@@ -0,0 +1,2 @@
+builtin(include,tcl.m4)
+builtin(include,../cygtcl.m4)
diff --git a/tk/win/configure b/tk/win/configure
index 20cf223f653..601e2868c1c 100755
--- a/tk/win/configure
+++ b/tk/win/configure
@@ -1,7 +1,7 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated automatically using autoconf version 2.12.2
+# Generated automatically using autoconf version 2.13
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
@@ -12,7 +12,13 @@ ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
ac_help="$ac_help
- --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ --enable-threads build with threads"
+ac_help="$ac_help
+ --enable-shared build and link with shared libraries [--enable-shared]"
+ac_help="$ac_help
+ --enable-symbols build with debugging symbols [--disable-symbols]"
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.3 binaries from DIR"
# Initialize some variables set by options.
# The variables have the same names as the options, with
@@ -30,6 +36,7 @@ program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
+sitefile=
srcdir=
target=NONE
verbose=
@@ -144,6 +151,7 @@ Configuration:
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
+ --site-file=FILE use FILE as the site file
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
@@ -314,6 +322,11 @@ EOF
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
+ -site-file | --site-file | --site-fil | --site-fi | --site-f)
+ ac_prev=sitefile ;;
+ -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+ sitefile="$ac_optarg" ;;
+
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
@@ -335,7 +348,7 @@ EOF
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
- echo "configure generated by autoconf version 2.12.2"
+ echo "configure generated by autoconf version 2.13"
exit 0 ;;
-with-* | --with-*)
@@ -479,12 +492,16 @@ fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+if test -z "$sitefile"; then
+ if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
fi
+else
+ CONFIG_SITE="$sitefile"
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
@@ -524,6 +541,12 @@ fi
+TK_VERSION=8.3
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=3
+TK_PATCH_LEVEL=".2"
+VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
@@ -531,57 +554,14 @@ if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess=$ac_aux_dir/config.guess
-ac_config_sub=$ac_aux_dir/config.sub
-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
-
-
-# Make sure we can run config.sub.
-if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
-else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
-fi
-
-echo $ac_n "checking host system type""... $ac_c" 1>&6
-echo "configure:561: checking host system type" >&5
-
-host_alias=$host
-case "$host_alias" in
-NONE)
- case $nonopt in
- NONE)
- if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
- else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
- fi ;;
- *) host_alias=$nonopt ;;
- esac ;;
-esac
-
-host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
-host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-echo "$ac_t""$host" 1>&6
-
+#------------------------------------------------------------------------
+# Standard compiler checks
+#------------------------------------------------------------------------
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
-echo "configure:585: checking for $ac_word" >&5
+echo "configure:565: 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
@@ -589,7 +569,8 @@ else
ac_cv_prog_CC="$CC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- for ac_dir in $PATH; do
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_CC="gcc"
@@ -610,7 +591,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:614: checking for $ac_word" >&5
+echo "configure:595: 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
@@ -619,7 +600,8 @@ else
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
ac_prog_rejected=no
- for ac_dir in $PATH; do
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
@@ -660,7 +642,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:664: checking for $ac_word" >&5
+echo "configure:646: checking for $ac_word" >&5
if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
@@ -668,7 +650,8 @@ else
ac_cv_prog_CC="$CC" # Let the user override the test.
else
IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
- for ac_dir in $PATH; do
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$ac_word; then
ac_cv_prog_CC="cl"
@@ -691,7 +674,7 @@ fi
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
-echo "configure:695: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+echo "configure:678: 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.
@@ -700,12 +683,14 @@ ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
cross_compiling=$ac_cv_prog_cc_cross
-cat > conftest.$ac_ext <<EOF
-#line 705 "configure"
+cat > conftest.$ac_ext << EOF
+
+#line 689 "configure"
#include "confdefs.h"
+
main(){return(0);}
EOF
-if { (eval echo configure:709: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+if { (eval echo configure:694: \"$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
@@ -719,18 +704,24 @@ else
ac_cv_prog_cc_works=no
fi
rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
if test $ac_cv_prog_cc_works = no; then
{ echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
fi
echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
-echo "configure:729: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "configure:720: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
cross_compiling=$ac_cv_prog_cc_cross
echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
-echo "configure:734: checking whether we are using GNU C" >&5
+echo "configure:725: 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
@@ -739,7 +730,7 @@ else
yes;
#endif
EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:743: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:734: \"$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
@@ -758,7 +749,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:762: checking whether ${CC-cc} accepts -g" >&5
+echo "configure:753: 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
@@ -789,14 +780,361 @@ else
fi
fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:811: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+echo $ac_n "checking build system type""... $ac_c" 1>&6
+echo "configure:832: checking build system type" >&5
+
+build_alias=$build
+case "$build_alias" in
+NONE)
+ case $nonopt in
+ NONE) build_alias=$host_alias ;;
+ *) build_alias=$nonopt ;;
+ esac ;;
+esac
+
+build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias`
+build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$build" 1>&6
+
+if test $host != $build; then
+ ac_tool_prefix=${host_alias}-
+else
+ ac_tool_prefix=
+fi
+
+# Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ar; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:858: 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
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_AR="${ac_tool_prefix}ar"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+ echo "$ac_t""$AR" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_AR"; then
+if test -n "$ac_tool_prefix"; 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:890: 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
+ if test -n "$AR"; then
+ ac_cv_prog_AR="$AR" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_AR="ar"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_AR" && ac_cv_prog_AR=":"
+fi
+fi
+AR="$ac_cv_prog_AR"
+if test -n "$AR"; then
+ echo "$ac_t""$AR" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ AR=":"
+fi
+fi
+
+# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:925: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_RANLIB"; then
+if test -n "$ac_tool_prefix"; then
+ # 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:957: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ RANLIB=":"
+fi
+fi
+
+# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:992: 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
+ if test -n "$RC"; then
+ ac_cv_prog_RC="$RC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RC="${ac_tool_prefix}windres"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+RC="$ac_cv_prog_RC"
+if test -n "$RC"; then
+ echo "$ac_t""$RC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_RC"; then
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1024: 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
+ if test -n "$RC"; then
+ ac_cv_prog_RC="$RC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RC="windres"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RC" && ac_cv_prog_RC=":"
+fi
+fi
+RC="$ac_cv_prog_RC"
+if test -n "$RC"; then
+ echo "$ac_t""$RC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ RC=":"
+fi
+fi
+
+
+#--------------------------------------------------------------------
+# Checks to see if the make progeam sets the $MAKE variable.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:1062: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+#--------------------------------------------------------------------
+# These two macros perform additinal compiler test.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
+echo "configure:1094: 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 1099 "configure"
+#include "confdefs.h"
+
+int main() {
+
+#ifndef __CYGWIN__
+#define __CYGWIN__ __CYGWIN32__
+#endif
+return __CYGWIN__;
+; return 0; }
+EOF
+if { (eval echo configure:1110: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_cygwin=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_cygwin=no
+fi
+rm -f conftest*
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_cygwin" 1>&6
+CYGWIN=
+test "$ac_cv_cygwin" = yes && CYGWIN=yes
+
+#--------------------------------------------------------------------
+# Determines the correct binary file extension (.o, .obj, .exe etc.)
+#--------------------------------------------------------------------
+
echo $ac_n "checking for object suffix""... $ac_c" 1>&6
-echo "configure:794: checking for object suffix" >&5
+echo "configure:1132: checking for object suffix" >&5
if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
echo $ac_n "(cached) $ac_c" 1>&6
else
rm -f conftest*
echo 'int i = 1;' > conftest.$ac_ext
-if { (eval echo configure:800: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+if { (eval echo configure:1138: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
for ac_file in conftest.*; do
case $ac_file in
*.c) ;;
@@ -813,145 +1151,1237 @@ echo "$ac_t""$ac_cv_objext" 1>&6
OBJEXT=$ac_cv_objext
ac_objext=$ac_cv_objext
-NM=${NM-nm}
+echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
+echo "configure:1156: 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 1161 "configure"
+#include "confdefs.h"
-AS=${AS-as}
+int main() {
+return __MINGW32__;
+; return 0; }
+EOF
+if { (eval echo configure:1168: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_mingw32=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_mingw32=no
+fi
+rm -f conftest*
+rm -f conftest*
+fi
-LD=${LD-ld}
+echo "$ac_t""$ac_cv_mingw32" 1>&6
+MINGW32=
+test "$ac_cv_mingw32" = yes && MINGW32=yes
-DLLTOOL=${DLLTOOL-dlltool}
-WINDRES=${WINDRES-windres}
+echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
+echo "configure:1187: checking for executable suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$CYGWIN" = yes || test "$MINGW32" = yes; then
+ ac_cv_exeext=.exe
+else
+ rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.$ac_ext
+ ac_cv_exeext=
+ if { (eval echo configure:1197: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ else
+ { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; }
+ fi
+ rm -f conftest*
+ test x"${ac_cv_exeext}" = x && ac_cv_exeext=no
+fi
+fi
+
+EXEEXT=""
+test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext}
+echo "$ac_t""${ac_cv_exeext}" 1>&6
+ac_exeext=$EXEEXT
+
+
+#--------------------------------------------------------------------
+# Check whether --enable-threads or --disable-threads was given.
+#--------------------------------------------------------------------
+
+
+ echo $ac_n "checking for building with threads""... $ac_c" 1>&6
+echo "configure:1224: 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"
+ tcl_ok=$enableval
+else
+ tcl_ok=no
+fi
+
+
+ if test "$tcl_ok" = "yes"; then
+ echo "$ac_t""yes" 1>&6
+ TCL_THREADS=1
+ cat >> confdefs.h <<\EOF
+#define TCL_THREADS 1
+EOF
+
+ else
+ TCL_THREADS=0
+ echo "$ac_t""no (default)" 1>&6
+ fi
+
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# 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:1254: 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"
+ tcl_ok=$enableval
+else
+ tcl_ok=yes
+fi
+
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=yes
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ echo "$ac_t""shared" 1>&6
+ SHARED_BUILD=1
+ else
+ echo "$ac_t""static" 1>&6
+ SHARED_BUILD=0
+ cat >> confdefs.h <<\EOF
+#define STATIC_BUILD 1
+EOF
+
+ fi
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
-echo "configure:839: checking for a BSD compatible install" >&5
-if test -z "$INSTALL"; then
-if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+
+#--------------------------------------------------------------------
+# 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.
+#--------------------------------------------------------------------
+
+
+ TCL_LIB_VERSIONS_OK=nodots
+
+ # 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:1296: 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
- IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
- for ac_dir in $PATH; do
- # Account for people who put trailing slashes in PATH elements.
- case "$ac_dir/" in
- /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- if test -f $ac_dir/$ac_prog; then
- if test $ac_prog = install &&
- grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- else
- ac_cv_path_install="$ac_dir/$ac_prog -c"
- break 2
- fi
- fi
- done
- ;;
- esac
+ if test -n "$CYGPATH"; then
+ ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CYGPATH="cygpath -w"
+ break
+ fi
done
- IFS="$ac_save_IFS"
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
+fi
+fi
+CYGPATH="$ac_cv_prog_CYGPATH"
+if test -n "$CYGPATH"; then
+ echo "$ac_t""$CYGPATH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+ # Check for a bug in gcc's windres that causes the
+ # compile to fail when a Windows native path is
+ # passed into windres. The mingw toolchain requires
+ # Windows native paths while Cygwin should work
+ # with both. Avoid the bug by passing a POSIX
+ # path when using the Cygwin toolchain.
+
+ if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
+ conftest=/tmp/conftest.rc
+ echo "STRINGTABLE BEGIN" > $conftest
+ echo "101 \"name\"" >> $conftest
+ echo "END" >> $conftest
+
+ echo $ac_n "checking for Windows native path bug in windres""... $ac_c" 1>&6
+echo "configure:1338: checking for Windows native path bug in windres" >&5
+ cyg_conftest=`$CYGPATH $conftest`
+ if { ac_try='$RC -o conftest.res.o $cyg_conftest'; { (eval echo configure:1340: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } ; then
+ echo "$ac_t""no" 1>&6
+ else
+ echo "$ac_t""yes" 1>&6
+ CYGPATH=echo
+ fi
+ conftest=
+ cyg_conftest=
+ fi
+
+ if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
+ DEPARG='"$<"'
+ else
+ DEPARG='"$(shell $(CYGPATH) $<)"'
+ fi
+
+ VENDORPREFIX=""
+
+ # 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:1361: checking compiler flags" >&5
+ if test "${GCC}" = "yes" ; then
+
+ # CYGNUS LOCAL
+ VENDORPREFIX="cyg"
+
+ SHLIB_LD=""
+ SHLIB_LD_LIBS=""
+ LIBS=""
+ LIBS_GUI="-lgdi32 -lcomdlg32"
+ STLIB_LD="${AR} cr"
+ RC_OUT=-o
+ RC_TYPE=
+ RC_INCLUDE=--include
+ RES=res.o
+ MAKE_LIB="\${STLIB_LD} \$@"
+ POST_MAKE_LIB="\${RANLIB} \$@"
+ MAKE_EXE="\${CC} -o \$@"
+ LIBPREFIX="lib${VENDORPREFIX}"
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ echo "$ac_t""using static flags" 1>&6
+ runtime=
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.a"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ echo "$ac_t""using shared flags" 1>&6
+
+ # ad-hoc check to see if CC supports -shared.
+ if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
+ { echo "configure: error: ${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain." 1>&2; exit 1; }
+ fi
+
+ runtime=
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt. We also need to add CFLAGS so important
+ # flags like -mno-cygwin get passed in to CC.
+ SHLIB_LD='${CC} -shared ${CFLAGS}'
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)"
+
+ LIBSUFFIX="\${DBGX}.a"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ CFLAGS_WARNING="-Wall -Wconversion"
+ LDFLAGS_DEBUG=
+ LDFLAGS_OPTIMIZE=
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-o \$@"
+ CC_EXENAME="-o \$@"
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ #
+ # We need to pass -e _WinMain@16 so that ld will use
+ # WinMain() instead of main() as the entry point. We can't
+ # use autoconf to check for this case since it would need
+ # to run an executable and that does not work when
+ # cross compiling. Remove this -e workaround once we
+ # require a gcc that does not have this bug.
+ LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
+ LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
+ else
+ # CYGNUS LOCAL
+ VENDORPREFIX="sn"
+
+ SHLIB_LD="link -dll -nologo"
+ SHLIB_LD_LIBS="user32.lib advapi32.lib"
+ LIBS="user32.lib advapi32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib"
+ STLIB_LD="lib -nologo"
+ RC="rc"
+ RC_OUT=-fo
+ RC_TYPE=-r
+ RC_INCLUDE=-i
+ RES=res
+ MAKE_LIB="\${STLIB_LD} -out:\$@"
+ POST_MAKE_LIB=
+ MAKE_EXE="\${CC} -Fe\$@"
+ LIBPREFIX=${VENDORPREFIX}
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ echo "$ac_t""using static flags" 1>&6
+ runtime=-MT
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.lib"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ echo "$ac_t""using shared flags" 1>&6
+ runtime=-MD
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
+ LIBSUFFIX="\${DBGX}.lib"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ EXTRA_CFLAGS="-YX"
+ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
+# CFLAGS_OPTIMIZE="-nologo -O2 -Gs -GD ${runtime}"
+ CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
+ CFLAGS_WARNING="-W3"
+ LDFLAGS_DEBUG="-debug:full -debugtype:cv"
+ LDFLAGS_OPTIMIZE="-release"
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-Fo\$@"
+ CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ LDFLAGS_CONSOLE="-link -subsystem:console"
+ LDFLAGS_WINDOW="-link -subsystem:windows"
+ fi
+ # TCL_LIB_SUFFIX is defined here and in tclConfig.sh so that macros
+ # can use a single variable name for both Tcl and extensions.
+ TCL_LIB_SUFFIX=$LIBSUFFIX
+
+
+#--------------------------------------------------------------------
+# 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:1504: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL="$ac_cv_path_install"
- else
- # As a last resort, use the slow shell script. We don't cache a
- # path for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the path is relative.
- INSTALL="$ac_install_sh"
- fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1519 "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:1525: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1536 "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:1542: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1553 "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:1559: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
fi
-echo "$ac_t""$INSTALL" 1>&6
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+ac_safe=`echo "errno.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for errno.h""... $ac_c" 1>&6
+echo "configure:1585: 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 1590 "configure"
+#include "confdefs.h"
+#include <errno.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1595: \"$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
+MAN2TCLFLAGS="-DNO_ERRNO_H"
+fi
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-# needed for the subtle differences between cygwin and mingw32
-case "${host}" in
-*-*-cygwin*)
- DLL_LDLIBS=-lcygwin
- DLL_LDFLAGS='-nostartfiles -Wl,--dll'
- ;;
-*-*-mingw32*)
- DLL_LDLIBS=
- DLL_LDFLAGS='-mdll'
- ;;
-esac
+#--------------------------------------------------------------------
+# 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:1627: 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.
+#--------------------------------------------------------------------
-# The following stuff is just for tkConfig.sh, not for Makefile.
+ echo $ac_n "checking the location of tclConfig.sh""... $ac_c" 1>&6
+echo "configure:1658: checking the location of tclConfig.sh" >&5
-# Check whether --with-tcl or --without-tcl was given.
+# CYGNUS LOCAL
+ if test -d ../../tcl8.1/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.1/win
+ else
+ TCL_BIN_DIR_DEFAULT=../../tcl/win
+ fi
+# END CYGNUS LOCAL
+
+ # Check whether --with-tcl or --without-tcl was given.
if test "${with_tcl+set}" = set; then
withval="$with_tcl"
TCL_BIN_DIR=$withval
else
- TCL_BIN_DIR=`cd ../../tcl/unix; pwd`
+ 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 doesn't exist" 1>&2; exit 1; }
+ 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:1686: 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
+
+ # The eval is required to do the TCL_DBGX substitution in the
+ # TCL_LIB_FILE variable.
+
+ eval TCL_LIB_FILE=${TCL_LIB_FILE}
+ eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+
+
+
+
+
+
+#------------------------------------------------------------------------
+# tkConfig.sh refers to this by a different name
+#------------------------------------------------------------------------
+
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+#--------------------------------------------------------------------
+# Perform final evaluations of variables with possible substitutions.
+#--------------------------------------------------------------------
+
+NODOT_VERSION=${VER}
+
+TK_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TK_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TK_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+
+
+ val="`cd $srcdir/..; pwd`"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_SRC_DIR" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_SRC_DIR=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_SRC_DIR="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_SRC_DIR=$val
+ ;;
+ esac
+
+
+
+ libname=tk
+ suffix=${TK_SHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32* | *cygwin*)
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TK_DLL_FILE=$long_libname
+
+
+ libname=tk
+ suffix=${TK_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TK_LIB_FILE=$long_libname
+
+
+ libname=tkstub
+ suffix=${TK_UNSHARED_LIB_SUFFIX}
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "long_libname=\"${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ else
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ fi
+ ;;
+ *)
+ eval "long_libname=\"lib${TCL_VENDOR_PREFIX}${libname}${suffix}\""
+ ;;
+ esac
+
+ eval "long_libname=${long_libname}"
+
+ # Trick to replace DBGX with TCL_DBGX
+ DBGX='${TCL_DBGX}'
+ eval "long_libname=${long_libname}"
+
+ TK_STUB_LIB_FILE=$long_libname
+
+
+if test "$GCC" = "yes"; then
+ GNU_TK_LIB_FILE=${TK_LIB_FILE}
+ MSVC_TK_LIB_FILE=
+else
+ GNU_TK_LIB_FILE=
+ MSVC_TK_LIB_FILE=${TK_LIB_FILE}
fi
-if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
- { echo "configure: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+
+
+ libname=tkstub
+ version=${TK_VERSION}
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TK_STUB_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TK_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_BUILD_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_BUILD_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_BUILD_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_BUILD_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_BUILD_STUB_LIB_SPEC="-L${dirname} ${TK_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_BUILD_STUB_LIB_SPEC="-L`pwd` ${TK_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TK_STUB_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_STUB_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_STUB_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_STUB_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_STUB_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_STUB_LIB_SPEC="-L${dirname} ${TK_STUB_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_STUB_LIB_SPEC="-L${exec_prefix}/lib ${TK_STUB_LIB_FLAG}"
+ ;;
+ esac
+
+
+
+
+ val="`pwd`/${TK_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_BUILD_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_BUILD_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_BUILD_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_BUILD_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+
+ val="${exec_prefix}/lib/${TK_STUB_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_STUB_LIB_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_STUB_LIB_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_STUB_LIB_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_STUB_LIB_PATH=$val
+ ;;
+ esac
+
+
+
+eval "DLLSUFFIX=${DLLSUFFIX}"
+eval "LIBPREFIX=${LIBPREFIX}"
+eval "LIBSUFFIX=${LIBSUFFIX}"
+eval "EXESUFFIX=${EXESUFFIX}"
+
+
+ libname=tk
+ version=$TK_VERSION
+
+ if test "$TCL_LIB_SUFFIX" = "" ; then
+ { echo "configure: error: The TCL_LIB_SUFFIX variable is not defined" 1>&2; exit 1; }
+ fi
+
+ # If the . character is not allowed in lib name, remove it from version
+ if test "${TCL_LIB_VERSIONS_OK}" != "ok"; then
+ version=`echo $version | tr -d .`
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+ eval "short_libname=\"${TCL_VENDOR_PREFIX}${libname}${version}${TCL_LIB_SUFFIX}\""
+ else
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}${TCL_DBGX}"
+ fi
+ ;;
+ *)
+ short_libname="-l${TCL_VENDOR_PREFIX}${libname}${version}\${TCL_DBGX}"
+ ;;
+ esac
+
+ TK_LIB_FLAG=$short_libname
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="`pwd`/${TK_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_BUILD_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_BUILD_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_BUILD_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_BUILD_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=`pwd`
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_BUILD_LIB_SPEC="-L${dirname} ${TK_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_BUILD_LIB_SPEC="-L`pwd` ${TK_LIB_FLAG}"
+ ;;
+ esac
+
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "$GCC" != yes; then
+
+ val="${exec_prefix}/lib/${TK_LIB_FLAG}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_LIB_SPEC" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_LIB_SPEC=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_LIB_SPEC="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_LIB_SPEC=$val
+ ;;
+ esac
+
+ else
+
+ val=${exec_prefix}/lib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable dirname" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ dirname=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ dirname="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ dirname=$val
+ ;;
+ esac
+
+ TK_LIB_SPEC="-L${dirname} ${TK_LIB_FLAG}"
+ fi
+ ;;
+ *)
+ TK_LIB_SPEC="-L${exec_prefix}/lib ${TK_LIB_FLAG}"
+ ;;
+ esac
+
+
+
+ val="`pwd`/${TK_LIB_FILE}"
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable TK_LIB_FULL_PATH" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ TK_LIB_FULL_PATH=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ TK_LIB_FULL_PATH="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ TK_LIB_FULL_PATH=$val
+ ;;
+ esac
+
+
+
+if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
+ WISH_RES=wish_static.${RES}
+ TK_RES=
+else
+ WISH_RES=wish_static.${RES}
+ TK_RES=tk_dll.${RES}
fi
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+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}
+
+# Add X include path, it must be in a format
+# like -I"C:/Dir" and not -I"C:\Dir" or VC++ will puke.
+
+ val=$srcdir/../xlib
+
+ if test "$val" = "" ; then
+ { echo "configure: error: Empty value for variable XINCLUDES" 1>&2; exit 1; }
+ fi
+
+ case "${host}" in
+ *windows32* | *mingw32*)
+ if test "${CYGPATH}" = ""; then
+ { echo "configure: error: CYGPATH variable is not defined." 1>&2; exit 1; }
+ elif test "${CYGPATH}" = "echo"; then
+ # No cygpath when cross compiling
+ XINCLUDES=$val
+ else
+ # store literal argument text in a variable
+ val=$val
+ # Convert Cygwin to Windows path (/tmp/foo -> C:\Tmp\foo)
+ val="`${CYGPATH} $val`"
+ # Convert path like C:\Tmp\foo to C:/Tmp/foo
+ XINCLUDES="`echo $val | sed -e s#\\\\\\\\#/#g`"
+ fi
+ ;;
+ *)
+ # Default to a no-op under Unix or Cygwin gcc
+ XINCLUDES=$val
+ ;;
+ esac
+
+XINCLUDES="-I\"${XINCLUDES}\""
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-file=$TCL_BIN_DIR/tclConfig.sh
-. $file
-SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
-SHLIB_LD=$TCL_SHLIB_LD
-SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
-SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
-SHLIB_VERSION=$TCL_SHLIB_VERSION
-DL_LIBS=$TCL_DL_LIBS
-LD_FLAGS=$TCL_LD_FLAGS
-TK_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
-LIBOBJS=
-TK_VERSION=8.0
-TK_MAJOR_VERSION=8
-TK_MINOR_VERSION=0
-TK_PATCH_LEVEL=p2
-VERSION=${TK_VERSION}
-MATH_LIBS=-lm
-LIBOBJS=
-TK_SHLIB_CFLAGS=""
-eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
-TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
-TK_SRC_DIR=`cd $srcdir/..; pwd`
-XINCLUDES="-I`cd $srcdir/../xlib; pwd`"
-XLIBSW=
-TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd` -I`cd $srcdir/../xlib; pwd`"
-TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
-TK_LIB_SPEC="-L${exec_prefix}/lib -ltk`echo ${VERSION} | tr -d .`"
@@ -991,7 +2421,7 @@ EOF
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
- case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
*ac_space=\ *)
# `set' does not quote correctly, so add quotes (double-quote substitution
# turns \\\\ into \\, and sed turns \\ into \).
@@ -1070,7 +2500,7 @@ do
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
- echo "$CONFIG_STATUS generated by autoconf version 2.12.2"
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
@@ -1079,9 +2509,8 @@ do
done
ac_given_srcdir=$srcdir
-ac_given_INSTALL="$INSTALL"
-trap 'rm -fr `echo "Makefile ../unix/tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+trap 'rm -fr `echo "Makefile tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
@@ -1094,6 +2523,7 @@ s%@SHELL@%$SHELL%g
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
@@ -1112,38 +2542,100 @@ s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
+s%@CC@%$CC%g
s%@host@%$host%g
s%@host_alias@%$host_alias%g
s%@host_cpu@%$host_cpu%g
s%@host_vendor@%$host_vendor%g
s%@host_os@%$host_os%g
-s%@CC@%$CC%g
+s%@build@%$build%g
+s%@build_alias@%$build_alias%g
+s%@build_cpu@%$build_cpu%g
+s%@build_vendor@%$build_vendor%g
+s%@build_os@%$build_os%g
+s%@AR@%$AR%g
+s%@RANLIB@%$RANLIB%g
+s%@RC@%$RC%g
+s%@SET_MAKE@%$SET_MAKE%g
s%@OBJEXT@%$OBJEXT%g
-s%@NM@%$NM%g
-s%@AS@%$AS%g
-s%@LD@%$LD%g
-s%@DLLTOOL@%$DLLTOOL%g
-s%@WINDRES@%$WINDRES%g
-s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
-s%@INSTALL_DATA@%$INSTALL_DATA%g
-s%@TCL_ALLOC_OBJ@%$TCL_ALLOC_OBJ%g
-s%@DLL_LDFLAGS@%$DLL_LDFLAGS%g
-s%@DLL_LDLIBS@%$DLL_LDLIBS%g
-s%@LIBOBJS@%$LIBOBJS%g
-s%@DL_LIBS@%$DL_LIBS%g
-s%@LD_FLAGS@%$LD_FLAGS%g
-s%@MATH_LIBS@%$MATH_LIBS%g
-s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
-s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
-s%@TK_LIB_FILE@%$TK_LIB_FILE%g
-s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@EXEEXT@%$EXEEXT%g
+s%@CYGPATH@%$CYGPATH%g
+s%@CPP@%$CPP%g
+s%@MAN2TCLFLAGS@%$MAN2TCLFLAGS%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%@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%@GNU_TK_LIB_FILE@%$GNU_TK_LIB_FILE%g
+s%@MSVC_TK_LIB_FILE@%$MSVC_TK_LIB_FILE%g
+s%@TK_DLL_FILE@%$TK_DLL_FILE%g
+s%@TK_LIB_FLAG@%$TK_LIB_FLAG%g
+s%@TK_STUB_LIB_FILE@%$TK_STUB_LIB_FILE%g
+s%@TK_STUB_LIB_FLAG@%$TK_STUB_LIB_FLAG%g
+s%@TK_STUB_LIB_SPEC@%$TK_STUB_LIB_SPEC%g
+s%@TK_STUB_LIB_PATH@%$TK_STUB_LIB_PATH%g
+s%@TK_BUILD_STUB_LIB_SPEC@%$TK_BUILD_STUB_LIB_SPEC%g
+s%@TK_BUILD_STUB_LIB_PATH@%$TK_BUILD_STUB_LIB_PATH%g
s%@TK_SRC_DIR@%$TK_SRC_DIR%g
-s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_BIN_DIR@%$TK_BIN_DIR%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@TK_SHARED_BUILD@%$TK_SHARED_BUILD%g
+s%@WISH_RES@%$WISH_RES%g
+s%@TK_RES@%$TK_RES%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_DLL_FILE@%$TCL_DLL_FILE%g
+s%@TCL_STUB_LIB_FILE@%$TCL_STUB_LIB_FILE%g
+s%@TCL_STUB_LIB_FLAG@%$TCL_STUB_LIB_FLAG%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_BUILD_STUB_LIB_SPEC@%$TCL_BUILD_STUB_LIB_SPEC%g
+s%@TCL_DBGX@%$TCL_DBGX%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%@DEPARG@%$DEPARG%g
+s%@CFLAGS_DEFAULT@%$CFLAGS_DEFAULT%g
+s%@CFLAGS_DEBUG@%$CFLAGS_DEBUG%g
+s%@CFLAGS_OPTIMIZE@%$CFLAGS_OPTIMIZE%g
+s%@CFLAGS_WARNING@%$CFLAGS_WARNING%g
+s%@EXTRA_CFLAGS@%$EXTRA_CFLAGS%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
+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%@RC_OUT@%$RC_OUT%g
+s%@RC_TYPE@%$RC_TYPE%g
+s%@RC_INCLUDE@%$RC_INCLUDE%g
+s%@RES@%$RES%g
+s%@LIBS_GUI@%$LIBS_GUI%g
+s%@DLLSUFFIX@%$DLLSUFFIX%g
+s%@LIBPREFIX@%$LIBPREFIX%g
+s%@LIBSUFFIX@%$LIBSUFFIX%g
+s%@EXESUFFIX@%$EXESUFFIX%g
+s%@LIBRARIES@%$LIBRARIES%g
+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%@TK_XINCLUDES@%$TK_XINCLUDES%g
s%@XINCLUDES@%$XINCLUDES%g
-s%@XLIBSW@%$XLIBSW%g
CEOF
EOF
@@ -1185,7 +2677,7 @@ EOF
cat >> $CONFIG_STATUS <<EOF
-CONFIG_FILES=\${CONFIG_FILES-"Makefile ../unix/tkConfig.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
@@ -1220,10 +2712,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
- case "$ac_given_INSTALL" in
- [/$]*) INSTALL="$ac_given_INSTALL" ;;
- *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
- esac
echo creating "$ac_file"
rm -f "$ac_file"
@@ -1239,7 +2727,6 @@ for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
-s%@INSTALL@%$INSTALL%g
" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
fi; done
rm -f conftest.s*
diff --git a/tk/win/configure.in b/tk/win/configure.in
index d9c6949ef9e..51be87e08dd 100755
--- a/tk/win/configure.in
+++ b/tk/win/configure.in
@@ -1,13 +1,17 @@
-nl The file is CYGNUS LOCAL. It is used for cygwin.
-
-dnl This file is an input file used by the GNU "autoconf" program to
-dnl generate the file "configure", which is run during Tcl installation
-dnl to configure the system for the local environment.
-
-AC_PREREQ(2.5)
+# This file is an input file used by the GNU "autoconf" program to
+# generate the file "configure", which is run during Tk installation
+# to configure the system for the local environment.
+#
+# RCS: @(#) $Id$
AC_INIT(../generic/tk.h)
+TK_VERSION=8.3
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=3
+TK_PATCH_LEVEL=".2"
+VER=$TK_MAJOR_VERSION$TK_MINOR_VERSION
+
if test "${prefix}" = "NONE"; then
prefix=/usr/local
fi
@@ -15,96 +19,226 @@ if test "${exec_prefix}" = "NONE"; then
exec_prefix=$prefix
fi
-AC_CANONICAL_HOST
+#------------------------------------------------------------------------
+# Standard compiler checks
+#------------------------------------------------------------------------
AC_PROG_CC
+
+AC_CHECK_TOOL(AR, ar, :)
+AC_CHECK_TOOL(RANLIB, ranlib, :)
+AC_CHECK_TOOL(RC, windres, :)
+
+#--------------------------------------------------------------------
+# Checks to see if the make progeam sets the $MAKE variable.
+#--------------------------------------------------------------------
+
+AC_PROG_MAKE_SET
+
+#--------------------------------------------------------------------
+# These two macros perform additinal compiler test.
+#--------------------------------------------------------------------
+
+AC_CYGWIN
+
+#--------------------------------------------------------------------
+# Determines the correct binary file extension (.o, .obj, .exe etc.)
+#--------------------------------------------------------------------
+
AC_OBJEXT
-NM=${NM-nm}
-AC_SUBST(NM)
-AS=${AS-as}
-AC_SUBST(AS)
-LD=${LD-ld}
-AC_SUBST(LD)
-DLLTOOL=${DLLTOOL-dlltool}
-AC_SUBST(DLLTOOL)
-WINDRES=${WINDRES-windres}
-AC_SUBST(WINDRES)
-AC_PROG_INSTALL
-
-# needed for the subtle differences between cygwin and mingw32
-case "${host}" in
-*-*-cygwin*)
- DLL_LDLIBS=-lcygwin
- DLL_LDFLAGS='-nostartfiles -Wl,--dll'
- ;;
-*-*-mingw32*)
- DLL_LDLIBS=
- DLL_LDFLAGS='-mdll'
- ;;
-esac
-
-AC_SUBST(TCL_ALLOC_OBJ)
-AC_SUBST(DLL_LDFLAGS)
-AC_SUBST(DLL_LDLIBS)
-
-# The following stuff is just for tkConfig.sh, not for Makefile.
-
-AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
- TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl/unix; pwd`)
-if test ! -d $TCL_BIN_DIR; then
- AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
-fi
-if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
- AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
-fi
+AC_EXEEXT
-file=$TCL_BIN_DIR/tclConfig.sh
-. $file
-SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
-SHLIB_LD=$TCL_SHLIB_LD
-SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
-SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
-SHLIB_VERSION=$TCL_SHLIB_VERSION
-DL_LIBS=$TCL_DL_LIBS
-LD_FLAGS=$TCL_LD_FLAGS
-TK_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
-
-LIBOBJS=
-AC_SUBST(LIBOBJS)
-TK_VERSION=8.0
-TK_MAJOR_VERSION=8
-TK_MINOR_VERSION=0
-TK_PATCH_LEVEL=p2
-VERSION=${TK_VERSION}
+#--------------------------------------------------------------------
+# Check whether --enable-threads or --disable-threads was given.
+#--------------------------------------------------------------------
-MATH_LIBS=-lm
-LIBOBJS=
+SC_ENABLE_THREADS
-TK_SHLIB_CFLAGS=""
-eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libtk as a shared library instead of a static library.
+#--------------------------------------------------------------------
-TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
-TK_SRC_DIR=`cd $srcdir/..; pwd`
+SC_ENABLE_SHARED
-XINCLUDES="-I`cd $srcdir/../xlib; pwd`"
-XLIBSW=
-TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd` -I`cd $srcdir/../xlib; pwd`"
-TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
-TK_LIB_SPEC="-L${exec_prefix}/lib -ltk`echo ${VERSION} | tr -d .`"
+#--------------------------------------------------------------------
+# 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.
+#--------------------------------------------------------------------
-AC_SUBST(DL_LIBS)
-AC_SUBST(LD_FLAGS)
-AC_SUBST(MATH_LIBS)
-AC_SUBST(TK_BUILD_INCLUDES)
-AC_SUBST(TK_BUILD_LIB_SPEC)
-AC_SUBST(TK_LIB_FILE)
-AC_SUBST(TK_LIB_SPEC)
+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
+
+TK_DBGX=${DBGX}
+
+#--------------------------------------------------------------------
+# Locate and source the tclConfig.sh file.
+#--------------------------------------------------------------------
+
+SC_PATH_TCLCONFIG($TK_PATCH_LEVEL)
+SC_LOAD_TCLCONFIG
+
+#------------------------------------------------------------------------
+# tkConfig.sh refers to this by a different name
+#------------------------------------------------------------------------
+
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+#--------------------------------------------------------------------
+# Perform final evaluations of variables with possible substitutions.
+#--------------------------------------------------------------------
+
+NODOT_VERSION=${VER}
+
+TK_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
+TK_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+TK_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
+
+TCL_TOOL_PATH(TK_SRC_DIR, "`cd $srcdir/..; pwd`")
+
+TCL_TOOL_SHARED_LIB_LONGNAME(TK_DLL_FILE, tk, ${TK_SHARED_LIB_SUFFIX})
+TCL_TOOL_STATIC_LIB_LONGNAME(TK_LIB_FILE, tk, ${TK_UNSHARED_LIB_SUFFIX})
+TCL_TOOL_STATIC_LIB_LONGNAME(TK_STUB_LIB_FILE, tkstub, ${TK_UNSHARED_LIB_SUFFIX})
+
+if test "$GCC" = "yes"; then
+ GNU_TK_LIB_FILE=${TK_LIB_FILE}
+ MSVC_TK_LIB_FILE=
+else
+ GNU_TK_LIB_FILE=
+ MSVC_TK_LIB_FILE=${TK_LIB_FILE}
+fi
+
+TCL_TOOL_LIB_SHORTNAME(TK_STUB_LIB_FLAG, tkstub, ${TK_VERSION})
+TCL_TOOL_LIB_SPEC(TK_BUILD_STUB_LIB_SPEC, `pwd`, ${TK_STUB_LIB_FLAG})
+TCL_TOOL_LIB_SPEC(TK_STUB_LIB_SPEC, ${exec_prefix}/lib, ${TK_STUB_LIB_FLAG})
+
+TCL_TOOL_LIB_PATH(TK_BUILD_STUB_LIB_PATH, `pwd`, ${TK_STUB_LIB_FILE})
+TCL_TOOL_LIB_PATH(TK_STUB_LIB_PATH, ${exec_prefix}/lib, ${TK_STUB_LIB_FILE})
+
+eval "DLLSUFFIX=${DLLSUFFIX}"
+eval "LIBPREFIX=${LIBPREFIX}"
+eval "LIBSUFFIX=${LIBSUFFIX}"
+eval "EXESUFFIX=${EXESUFFIX}"
+
+TCL_TOOL_LIB_SHORTNAME(TK_LIB_FLAG, tk, $TK_VERSION)
+TCL_TOOL_LIB_SPEC(TK_BUILD_LIB_SPEC, `pwd`, ${TK_LIB_FLAG})
+TCL_TOOL_LIB_SPEC(TK_LIB_SPEC, ${exec_prefix}/lib, ${TK_LIB_FLAG})
+TCL_TOOL_LIB_PATH(TK_LIB_FULL_PATH, `pwd`, ${TK_LIB_FILE})
+
+if test "$SHARED_BUILD" = 0 -o $TCL_NEEDS_EXP_FILE = 0; then
+ WISH_RES=wish_static.${RES}
+ TK_RES=
+else
+ WISH_RES=wish_static.${RES}
+ TK_RES=tk_dll.${RES}
+fi
+TK_SHARED_BUILD=${SHARED_BUILD}
+
+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}
+
+# Add X include path, it must be in a format
+# like -I"C:/Dir" and not -I"C:\Dir" or VC++ will puke.
+TCL_TOOL_PATH(XINCLUDES, $srcdir/../xlib)
+XINCLUDES="-I\"${XINCLUDES}\""
+
+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(GNU_TK_LIB_FILE)
+AC_SUBST(MSVC_TK_LIB_FILE)
+AC_SUBST(TK_DLL_FILE)
+AC_SUBST(TK_LIB_FLAG)
+AC_SUBST(TK_STUB_LIB_FILE)
+AC_SUBST(TK_STUB_LIB_FLAG)
+AC_SUBST(TK_STUB_LIB_SPEC)
+AC_SUBST(TK_STUB_LIB_PATH)
+AC_SUBST(TK_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TK_BUILD_STUB_LIB_PATH)
AC_SUBST(TK_SRC_DIR)
-AC_SUBST(TK_VERSION)
+AC_SUBST(TK_BIN_DIR)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIB_SPEC)
+AC_SUBST(TK_LIB_FULL_PATH)
+AC_SUBST(TK_SHARED_BUILD)
+AC_SUBST(WISH_RES)
+AC_SUBST(TK_RES)
+
+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_DLL_FILE)
+AC_SUBST(TCL_STUB_LIB_FILE)
+AC_SUBST(TCL_STUB_LIB_FLAG)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TCL_DBGX)
+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)
+
+AC_SUBST(CYGPATH)
+AC_SUBST(DEPARG)
+AC_SUBST(CFLAGS_DEFAULT)
+AC_SUBST(CFLAGS_DEBUG)
+AC_SUBST(CFLAGS_OPTIMIZE)
+AC_SUBST(CFLAGS_WARNING)
+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)
+AC_SUBST(LDFLAGS_DEFAULT)
+AC_SUBST(LDFLAGS_DEBUG)
+AC_SUBST(LDFLAGS_OPTIMIZE)
+AC_SUBST(LDFLAGS_CONSOLE)
+AC_SUBST(LDFLAGS_WINDOW)
+AC_SUBST(AR)
+AC_SUBST(RANLIB)
+AC_SUBST(RC)
+AC_SUBST(RC_OUT)
+AC_SUBST(RC_TYPE)
+AC_SUBST(RC_INCLUDE)
+AC_SUBST(RES)
+AC_SUBST(LIBS)
+AC_SUBST(LIBS_GUI)
+AC_SUBST(DLLSUFFIX)
+AC_SUBST(LIBPREFIX)
+AC_SUBST(LIBSUFFIX)
+AC_SUBST(EXESUFFIX)
+AC_SUBST(LIBRARIES)
+AC_SUBST(MAKE_LIB)
+AC_SUBST(POST_MAKE_LIB)
+AC_SUBST(MAKE_DLL)
+AC_SUBST(MAKE_EXE)
+AC_SUBST(TK_XINCLUDES)
AC_SUBST(XINCLUDES)
-AC_SUBST(XLIBSW)
-AC_OUTPUT(Makefile ../unix/tkConfig.sh)
+AC_OUTPUT(Makefile tkConfig.sh)
diff --git a/tk/win/makefile.vc b/tk/win/makefile.vc
index 62a43056aa2..b74f01cb95e 100644
--- a/tk/win/makefile.vc
+++ b/tk/win/makefile.vc
@@ -3,8 +3,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# SCCS: @(#) makefile.vc 1.12 98/08/12 18:41:59
+# Copyright (c) 1995-1997 Sun Microsystems, Inc.
+# RCS: @(#) $Id$
# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
@@ -26,13 +26,23 @@
#
ROOT = ..
-TOOLS32 = c:\progra~1\devstudio\vc
-TOOLS32_rc = c:\progra~1\devstudio\sharedide
-TCLDIR = ..\..\tcl8.0
+TCLDIR = ..\..\tcl8.3
+INSTALLDIR = c:\progra~1\tcl
# Set this to the appropriate value of /MACHINE: for your platform
MACHINE = IX86
+!IF "$(MACHINE)" == "IA64"
+TOOLS32 = c:\ia64sdk17
+TOOLS32_rc = c:\ia64sdk17
+!ELSE
+TOOLS32 = c:\Progra~1\devstudio\vc
+TOOLS32_rc = c:\Progra~1\devstudio\sharedide
+!ENDIF
+
+# Uncomment the following line to compile with thread support
+#THREADDEFINES = -DTCL_THREADS=1
+
# Set NODEBUG to 0 to compile with symbols
NODEBUG = 1
@@ -46,7 +56,12 @@ NODEBUG = 1
TCLNAMEPREFIX = tcl
TKNAMEPREFIX = tk
WISHNAMEPREFIX = wish
-VERSION = 80
+VERSION = 83
+DOTVERSION = 8.3
+
+TCLSTUBPREFIX = $(TCLNAMEPREFIX)stub
+TKSTUBPREFIX = $(TKNAMEPREFIX)stub
+
BINROOT = .
!IF "$(NODEBUG)" == "1"
@@ -62,17 +77,26 @@ OUTDIR = $(TMPDIR)
TCLLIB = $(TCLNAMEPREFIX)$(VERSION)$(DBGX).lib
TCLPLUGINLIB = $(TCLNAMEPREFIX)$(VERSION)p.lib
+TCLSTUBLIB = $(TCLSTUBPREFIX)$(VERSION)$(DBGX).lib
TKDLLNAME = $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll
TKDLL = $(OUTDIR)\$(TKDLLNAME)
TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib
+TKSTUBLIBNAME = $(TKSTUBPREFIX)$(VERSION)$(DBGX).lib
+TKSTUBLIB = $(OUTDIR)\$(TKSTUBLIBNAME)
TKPLUGINDLLNAME = $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll
TKPLUGINDLL = $(OUTDIR)\$(TKPLUGINDLLNAME)
TKPLUGINLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib
WISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe
+WISHC = $(OUTDIR)\$(WISHNAMEPREFIX)c$(VERSION)$(DBGX).exe
WISHP = $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe
TKTEST = $(OUTDIR)\$(TKNAMEPREFIX)test.exe
-DUMPEXTS = $(TMPDIR)\dumpexts.exe
+CAT32 = $(TMPDIR)\cat32.exe
+
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+SCRIPT_INSTALL_DIR = $(LIB_INSTALL_DIR)\tk$(DOTVERSION)
WISHOBJS = \
$(TMPDIR)\winMain.obj
@@ -80,7 +104,9 @@ WISHOBJS = \
TKTESTOBJS = \
$(TMPDIR)\tkTest.obj \
$(TMPDIR)\tkSquare.obj \
- $(TMPDIR)\testMain.obj
+ $(TMPDIR)\testMain.obj \
+ $(TMPDIR)\tkWinTest.obj \
+ $(TCLLIBDIR)\tclThreadTest.obj
XLIBOBJS = \
$(TMPDIR)\xcolors.obj \
@@ -99,6 +125,7 @@ TKOBJS = \
$(TMPDIR)\tkWinButton.obj \
$(TMPDIR)\tkWinClipboard.obj \
$(TMPDIR)\tkWinColor.obj \
+ $(TMPDIR)\tkWinConfig.obj \
$(TMPDIR)\tkWinCursor.obj \
$(TMPDIR)\tkWinDialog.obj \
$(TMPDIR)\tkWinDraw.obj \
@@ -163,6 +190,8 @@ TKOBJS = \
$(TMPDIR)\tkMenubutton.obj \
$(TMPDIR)\tkMenuDraw.obj \
$(TMPDIR)\tkMessage.obj \
+ $(TMPDIR)\tkObj.obj \
+ $(TMPDIR)\tkOldConfig.obj \
$(TMPDIR)\tkOption.obj \
$(TMPDIR)\tkPack.obj \
$(TMPDIR)\tkPlace.obj \
@@ -182,12 +211,19 @@ TKOBJS = \
$(TMPDIR)\tkTrig.obj \
$(TMPDIR)\tkUtil.obj \
$(TMPDIR)\tkVisual.obj \
+ $(TMPDIR)\tkStubInit.obj \
+ $(TMPDIR)\tkStubLib.obj \
$(TMPDIR)\tkWindow.obj
-cc32 = $(TOOLS32)\bin\cl.exe
-link32 = $(TOOLS32)\bin\link.exe
-rc32 = $(TOOLS32_rc)\bin\rc.exe
-include32 = -I$(TOOLS32)\include
+TKSTUBOBJS = $(TMPDIR)\tkStubLib.obj \
+ $(TMPDIR)\tkStubImg.obj
+
+
+cc32 = "$(TOOLS32)\bin\cl.exe"
+link32 = "$(TOOLS32)\bin\link.exe"
+lib32 = "$(TOOLS32)\bin\lib.exe"
+rc32 = "$(TOOLS32_rc)\bin\rc.exe"
+include32 = -I"$(TOOLS32)\include"
WINDIR = $(ROOT)\win
GENERICDIR = $(ROOT)\generic
@@ -198,123 +234,145 @@ RCDIR = $(WINDIR)\rc
TK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(BITMAPDIR) -I$(XLIBDIR) \
-I$(TCLDIR)\generic
-TK_DEFINES = $(DEBUGDEFINES)
-
-TK_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
- $(TK_INCLUDES) $(TK_DEFINES)
+TK_DEFINES = -D__WIN32__ $(DEBUGDEFINES) $(THREADDEFINES)
######################################################################
-# Link flags
+# Compile flags
######################################################################
!IF "$(NODEBUG)" == "1"
-ldebug = /RELEASE
+!IF "$(MACHINE)" == "ALPHA"
+# MSVC on Alpha doesn't understand -Ot
+cdebug = -O2i -Gs -GD
!ELSE
-ldebug = -debug:full -debugtype:cv
+# NOTE: Due to a bug in MSVC, we cannot use -O2 here or Tk starts to misbehave.
+cdebug = -Oti -Gs -GD
!ENDIF
-
-# declarations common to all linker options
-lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
-
-# declarations for use on Intel i386, i486, and Pentium systems
-!IF "$(MACHINE)" == "IX86"
-DLLENTRY = @12
-lflags = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
!ELSE
-lflags = $(lcommon) /MACHINE:$(MACHINE)
-!ENDIF
-
-conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
-guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
-dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
-
-!IF "$(MACHINE)" == "PPC"
-libc = libc.lib
-libcdll = crtdll.lib
+!IF "$(MACHINE)" == "IA64"
+cdebug = -Od -Zi
!ELSE
-libc = libc.lib oldnames.lib
-libcdll = msvcrt.lib oldnames.lib
+cdebug = -Z7 -Od -WX
+!ENDIF
!ENDIF
-baselibs = kernel32.lib $(optlibs) advapi32.lib
-winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
-guilibs = $(libc) $(winlibs)
+# declarations common to all compiler options
+cflags = -c -W3 -nologo -Fp$(TMPDIR)\ -YX
+cvarsdll = -MD$(DBGX)
-guilibsdll = $(libcdll) $(winlibs)
+CON_CFLAGS = $(cdebug) $(cflags) $(include32) -DCONSOLE
+TK_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
+ $(TK_INCLUDES) $(TK_DEFINES) -DUSE_TCL_STUBS
+WISH_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
+ $(TK_INCLUDES) $(TK_DEFINES)
######################################################################
-# Compile flags
+# Link flags
######################################################################
!IF "$(NODEBUG)" == "1"
-!IF "$(MACHINE)" == "ALPHA"
-# MSVC on Alpha doesn't understand -Ot
-cdebug = -O2i -Gs -GD
-!ELSE
-cdebug = -Oti -Gs -GD
-!ENDIF
+ldebug = /RELEASE
!ELSE
-cdebug = -Z7 -Od -WX
+ldebug = -debug:full -debugtype:cv
!ENDIF
-# declarations common to all compiler options
-ccommon = -c -W3 -nologo -Fp$(TMPDIR)\ -YX
+# declarations common to all linker options
+lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
+lflags = $(lcommon) /MACHINE:$(MACHINE)
+# declarations for use on Intel i386, i486, and Pentium systems
!IF "$(MACHINE)" == "IX86"
-cflags = $(ccommon) -D_X86_=1
-!ELSE
-!IF "$(MACHINE)" == "MIPS"
-cflags = $(ccommon) -D_MIPS_=1
-!ELSE
-!IF "$(MACHINE)" == "PPC"
-cflags = $(ccommon) -D_PPC_=1
-!ELSE
-!IF "$(MACHINE)" == "ALPHA"
-cflags = $(ccommon) -D_ALPHA_=1
-!ENDIF
-!ENDIF
-!ENDIF
+DLLENTRY = @12
!ENDIF
-cvars = -DWIN32 -D_WIN32
-cvarsmt = $(cvars) -D_MT
-cvarsdll = $(cvarsmt) -D_DLL
+conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
+guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
+dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
-!IF "$(NODEBUG)" == "1"
-cvarsdll = $(cvars) -MD
+!IF "$(MACHINE)" == "PPC"
+libc = libc$(DBGX).lib
+libcdll = crtdll$(DBGX).lib
!ELSE
-cvarsdll = $(cvars) -MDd
+libc = libc$(DBGX).lib oldnames.lib
+libcdll = msvcrt$(DBGX).lib oldnames.lib
!ENDIF
-CON_CFLAGS = $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE
+baselibs = kernel32.lib $(optlibs) advapi32.lib
+winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
+guilibs = $(libc) $(winlibs)
+conlibs = $(libc) $(baselibs)
+guilibsdll = $(libcdll) $(winlibs)
######################################################################
# Project specific targets
######################################################################
-all: setup $(WISH)
-test: setup $(TKTEST)
+all: setup $(WISH) $(CAT32)
+install: install-binaries install-libraries
plugin: setup $(TKPLUGINDLL) $(WISHP)
+tktest: setup $(TKTEST) $(CAT32)
+test: setup $(TKTEST) $(TKLIB) $(CAT32)
+ set TCL_LIBRARY=$(TCLDIR)/library
+ set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH)
+ $(TKTEST) $(ROOT)/tests/all.tcl | $(CAT32)
+
+runtest: setup $(TKTEST) $(TKLIB) $(CAT32)
+ set TCL_LIBRARY=$(TCLDIR)/library
+ set PATH=$(TCLDIR)\win\$(TMPDIRNAME);$(PATH)
+ $(TKTEST)
+
+console-wish : all $(WISHC)
+
+stubs:
+ $(TCLDIR)\win\$(TMPDIRNAME)\tclsh$(VERSION)$(DBGX) \
+ $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls
setup:
@mkd $(TMPDIR)
@mkd $(OUTDIR)
-$(TKLIB): $(TKDLL)
-
-$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\tk.def
+install-binaries:
+ @mkd "$(BIN_INSTALL_DIR)"
+ copy $(TKDLL) "$(BIN_INSTALL_DIR)"
+ copy $(WISH) "$(BIN_INSTALL_DIR)"
+ @mkd "$(LIB_INSTALL_DIR)"
+ copy $(TKLIB) "$(LIB_INSTALL_DIR)"
+
+install-libraries:
+ @mkd "$(INCLUDE_INSTALL_DIR)"
+ @mkd "$(INCLUDE_INSTALL_DIR)\X11"
+ copy "$(ROOT)\generic\tk.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(ROOT)\generic\tkDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ copy "$(ROOT)\generic\tkIntXlibDecls.h" "$(INCLUDE_INSTALL_DIR)"
+ xcopy "$(ROOT)\xlib\X11\*.h" "$(INCLUDE_INSTALL_DIR)\X11"
+ @mkd "$(SCRIPT_INSTALL_DIR)"
+ @mkd "$(SCRIPT_INSTALL_DIR)\images"
+ @mkd "$(SCRIPT_INSTALL_DIR)\demos"
+ @mkd "$(SCRIPT_INSTALL_DIR)\demos\images"
+ xcopy "$(ROOT)\library" "$(SCRIPT_INSTALL_DIR)"
+ xcopy "$(ROOT)\library\images" "$(SCRIPT_INSTALL_DIR)\images"
+ xcopy "$(ROOT)\library\demos" "$(SCRIPT_INSTALL_DIR)\demos"
+ xcopy "$(ROOT)\library\demos\images" "$(SCRIPT_INSTALL_DIR)\demos\images"
+
+$(TKLIB): $(TKDLL) $(TKSTUBLIB)
+
+$(TKSTUBLIB): $(TKSTUBOBJS)
+ $(lib32) /out:$@ $(TKSTUBOBJS)
+
+$(TKDLL): $(TKOBJS) $(TMPDIR)\tk.res
set LIB=$(TOOLS32)\lib
- $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\tk.def \
- -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLLIB) \
+ $(link32) $(ldebug) $(dlllflags) \
+ -out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLSTUBLIB) \
$(guilibsdll) @<<
$(TKOBJS)
<<
$(TKPLUGINLIB): $(TKPLUGINDLL)
-$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res $(TMPDIR)\plugin.def
+$(TKPLUGINDLL): $(TKOBJS) $(TMPDIR)\tk.res
set LIB=$(TOOLS32)\lib
- $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\plugin.def \
+ $(link32) $(ldebug) $(dlllflags) \
-out:$@ $(TMPDIR)\tk.res $(TCLLIBDIR)\$(TCLPLUGINLIB) \
$(guilibsdll) @<<
$(TKOBJS)
@@ -325,6 +383,11 @@ $(WISH): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS)
+$(WISHC): $(WISHOBJS) $(TKLIB) $(TMPDIR)\wish.res
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(ldebug) $(conlflags) $(TMPDIR)\wish.res -out:$@ \
+ $(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(WISHOBJS)
+
$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) $(TMPDIR)\wish.res
set LIB=$(TOOLS32)\lib
$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
@@ -336,36 +399,39 @@ $(TKTEST): $(TKTESTOBJS) $(TKLIB) $(TMPDIR)\wish.res
$(link32) $(ldebug) $(guilflags) $(TMPDIR)\wish.res -out:$@ \
$(guilibsdll) $(TCLLIBDIR)\$(TCLLIB) $(TKLIB) $(TKTESTOBJS)
-$(TMPDIR)\tk.def: $(DUMPEXTS) $(TKOBJS)
- $(DUMPEXTS) -o $@ $(TKDLLNAME) @<<
- $(TKOBJS)
-<<
-
-$(TMPDIR)\plugin.def: $(DUMPEXTS) $(TKOBJS)
- $(DUMPEXTS) -o $@ $(TKPLUGINDLLNAME) @<<
- $(TKOBJS)
-<<
-
-$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
+$(CAT32): $(TCLDIR)\win\cat.c
$(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
set LIB=$(TOOLS32)\lib
- $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
- $(TMPDIR)\winDumpExts.obj
+ $(link32) $(conlflags) -out:$@ -stack:16384 $(TMPDIR)\cat.obj $(conlibs)
+
+#
+# Regenerate the stubs files.
+#
+
+genstubs:
+ tclsh$(VERSION) $(TCLDIR)\tools\genStubs.tcl $(GENERICDIR) \
+ $(GENERICDIR)\tk.decls $(GENERICDIR)\tkInt.decls
#
# Special case object file targets
#
$(TMPDIR)\testMain.obj: $(ROOT)\win\winMain.c
- $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -DTK_TEST -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -DTK_TEST -Fo$@ $?
$(TMPDIR)\tkTest.obj: $(ROOT)\generic\tkTest.c
- $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\tkWinTest.obj: $(ROOT)\generic\tkWinTest.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
$(TMPDIR)\tkSquare.obj: $(ROOT)\generic\tkSquare.c
- $(cc32) $(TK_CFLAGS) -Fo$@ $?
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
$(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c
+ $(cc32) $(WISH_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\tkStubLib.obj : $(GENERICDIR)\tkStubLib.c
$(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -Fo$@ $?
#
@@ -385,7 +451,8 @@ $(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c
$(cc32) -DDLL_BUILD -DBUILD_tk $(TK_CFLAGS) -Fo$(TMPDIR)\ $<
{$(RCDIR)}.rc{$(TMPDIR)}.res:
- $(rc32) -fo $@ -r -i $(GENERICDIR) $<
+ $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TOOLS32)\include" \
+ -i "$(TCLDIR)\generic" $<
clean:
-@del $(OUTDIR)\*.exp
@@ -396,7 +463,6 @@ clean:
-@del $(TMPDIR)\*.pch
-@del $(TMPDIR)\*.obj
-@del $(TMPDIR)\*.res
- -@del $(TMPDIR)\*.def
-@del $(TMPDIR)\*.exe
-@rmd $(OUTDIR)
-@rmd $(TMPDIR)
@@ -438,3 +504,5 @@ $(GENERICDIR)/tkMenu.c: $(GENERICDIR)/tkMenu.h
$(GENERICDIR)/tkMenuDraw.c: $(GENERICDIR)/tkMenu.h
$(WINDIR)/tkWinMenu.c: $(GENERICDIR)/tkMenu.h
+
+
diff --git a/tk/win/mkd.bat b/tk/win/mkd.bat
index 2bd2388394f..13203f1c7a1 100644
--- a/tk/win/mkd.bat
+++ b/tk/win/mkd.bat
@@ -19,3 +19,4 @@ echo TAG >%1\tag.txt
echo created directory %1
:end
+
diff --git a/tk/win/rc/tk.rc b/tk/win/rc/tk.rc
index 67f3e1422be..00d90046acb 100644
--- a/tk/win/rc/tk.rc
+++ b/tk/win/rc/tk.rc
@@ -1,8 +1,9 @@
-// SCCS: @(#) tk.rc 1.22 97/03/21 18:35:14
+// RCS: @(#) $Id$
//
// Version
//
+#include <windows.h>
#define RESOURCE_INCLUDED
#include <tk.h>
@@ -24,9 +25,9 @@ BEGIN
BEGIN
VALUE "FileDescription", "Tk DLL\0"
VALUE "OriginalFilename", "tk" STRINGIFY(TK_MAJOR_VERSION) STRINGIFY(TK_MINOR_VERSION) ".dll\0"
- VALUE "CompanyName", "Sun Microsystems, Inc.\0"
+ VALUE "CompanyName", "Scriptics Corporation\0"
VALUE "FileVersion", TK_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
+ VALUE "LegalCopyright", "Copyright \251 2000 by Scriptics Corporation\0"
VALUE "ProductName", "Tk " TK_VERSION " for Windows\0"
VALUE "ProductVersion", TK_PATCH_LEVEL
END
@@ -36,97 +37,3 @@ BEGIN
VALUE "Translation", 0x409, 1200
END
END
-
-//
-// Icons
-//
-
-tk ICON DISCARDABLE "cygnus.ico"
-
-//
-// Bitmaps
-//
-
-buttons BITMAP DISCARDABLE "buttons.bmp"
-
-//
-// Cursors
-//
-
-X_cursor CURSOR DISCARDABLE "cursor00.cur"
-arrow CURSOR DISCARDABLE "cursor02.cur"
-based_arrow_down CURSOR DISCARDABLE "cursor04.cur"
-based_arrow_up CURSOR DISCARDABLE "cursor06.cur"
-boat CURSOR DISCARDABLE "cursor08.cur"
-bogosity CURSOR DISCARDABLE "cursor0a.cur"
-bottom_left_corner CURSOR DISCARDABLE "cursor0c.cur"
-bottom_right_corner CURSOR DISCARDABLE "cursor0e.cur"
-bottom_side CURSOR DISCARDABLE "cursor10.cur"
-bottom_tee CURSOR DISCARDABLE "cursor12.cur"
-box_spiral CURSOR DISCARDABLE "cursor14.cur"
-center_ptr CURSOR DISCARDABLE "cursor16.cur"
-circle CURSOR DISCARDABLE "cursor18.cur"
-clock CURSOR DISCARDABLE "cursor1a.cur"
-coffee_mug CURSOR DISCARDABLE "cursor1c.cur"
-cross CURSOR DISCARDABLE "cursor1e.cur"
-cross_reverse CURSOR DISCARDABLE "cursor20.cur"
-crosshair CURSOR DISCARDABLE "cursor22.cur"
-diamond_cross CURSOR DISCARDABLE "cursor24.cur"
-dot CURSOR DISCARDABLE "cursor26.cur"
-dotbox CURSOR DISCARDABLE "cursor28.cur"
-double_arrow CURSOR DISCARDABLE "cursor2a.cur"
-draft_large CURSOR DISCARDABLE "cursor2c.cur"
-draft_small CURSOR DISCARDABLE "cursor2e.cur"
-draped_box CURSOR DISCARDABLE "cursor30.cur"
-exchange CURSOR DISCARDABLE "cursor32.cur"
-fleur CURSOR DISCARDABLE "cursor34.cur"
-gobbler CURSOR DISCARDABLE "cursor36.cur"
-gumby CURSOR DISCARDABLE "cursor38.cur"
-hand1 CURSOR DISCARDABLE "cursor3a.cur"
-hand2 CURSOR DISCARDABLE "cursor3c.cur"
-heart CURSOR DISCARDABLE "cursor3e.cur"
-icon CURSOR DISCARDABLE "cursor40.cur"
-iron_cross CURSOR DISCARDABLE "cursor42.cur"
-left_ptr CURSOR DISCARDABLE "cursor44.cur"
-left_side CURSOR DISCARDABLE "cursor46.cur"
-left_tee CURSOR DISCARDABLE "cursor48.cur"
-leftbutton CURSOR DISCARDABLE "cursor4a.cur"
-ll_angle CURSOR DISCARDABLE "cursor4c.cur"
-lr_angle CURSOR DISCARDABLE "cursor4e.cur"
-man CURSOR DISCARDABLE "cursor50.cur"
-middlebutton CURSOR DISCARDABLE "cursor52.cur"
-mouse CURSOR DISCARDABLE "cursor54.cur"
-pencil CURSOR DISCARDABLE "cursor56.cur"
-pirate CURSOR DISCARDABLE "cursor58.cur"
-plus CURSOR DISCARDABLE "cursor5a.cur"
-question_arrow CURSOR DISCARDABLE "cursor5c.cur"
-right_ptr CURSOR DISCARDABLE "cursor5e.cur"
-right_side CURSOR DISCARDABLE "cursor60.cur"
-right_tee CURSOR DISCARDABLE "cursor62.cur"
-rightbutton CURSOR DISCARDABLE "cursor64.cur"
-rtl_logo CURSOR DISCARDABLE "cursor66.cur"
-sailboat CURSOR DISCARDABLE "cursor68.cur"
-sb_down_arrow CURSOR DISCARDABLE "cursor6a.cur"
-sb_h_double_arrow CURSOR DISCARDABLE "cursor6c.cur"
-sb_left_arrow CURSOR DISCARDABLE "cursor6e.cur"
-sb_right_arrow CURSOR DISCARDABLE "cursor70.cur"
-sb_up_arrow CURSOR DISCARDABLE "cursor72.cur"
-sb_v_double_arrow CURSOR DISCARDABLE "cursor74.cur"
-shuttle CURSOR DISCARDABLE "cursor76.cur"
-sizing CURSOR DISCARDABLE "cursor78.cur"
-spider CURSOR DISCARDABLE "cursor7a.cur"
-spraycan CURSOR DISCARDABLE "cursor7c.cur"
-star CURSOR DISCARDABLE "cursor7e.cur"
-target CURSOR DISCARDABLE "cursor80.cur"
-tcross CURSOR DISCARDABLE "cursor82.cur"
-top_left_arrow CURSOR DISCARDABLE "cursor84.cur"
-top_left_corner CURSOR DISCARDABLE "cursor86.cur"
-top_right_corner CURSOR DISCARDABLE "cursor88.cur"
-top_side CURSOR DISCARDABLE "cursor8a.cur"
-top_tee CURSOR DISCARDABLE "cursor8c.cur"
-trek CURSOR DISCARDABLE "cursor8e.cur"
-ul_angle CURSOR DISCARDABLE "cursor90.cur"
-umbrella CURSOR DISCARDABLE "cursor92.cur"
-ur_angle CURSOR DISCARDABLE "cursor94.cur"
-watch CURSOR DISCARDABLE "cursor96.cur"
-xterm CURSOR DISCARDABLE "cursor98.cur"
diff --git a/tk/win/rc/tk_base.rc b/tk/win/rc/tk_base.rc
new file mode 100644
index 00000000000..52d64d21ae9
--- /dev/null
+++ b/tk/win/rc/tk_base.rc
@@ -0,0 +1,130 @@
+// 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/tk/win/rc/tk_dll.rc b/tk/win/rc/tk_dll.rc
new file mode 100644
index 00000000000..4cea329b679
--- /dev/null
+++ b/tk/win/rc/tk_dll.rc
@@ -0,0 +1,169 @@
+// RCS: @(#) $Id$
+//
+// Version
+//
+
+#include <windows.h>
+#define RESOURCE_INCLUDED
+#include <tk.h>
+
+#define STRINGIFY1(x) #x
+#define STRINGIFY(x) STRINGIFY1(x)
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ PRODUCTVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x2L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Tk DLL\0"
+ VALUE "OriginalFilename", "tk" STRINGIFY(TK_MAJOR_VERSION) STRINGIFY(TK_MINOR_VERSION) ".dll\0"
+ VALUE "CompanyName", "Scriptics Corporation\0"
+ VALUE "FileVersion", TK_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 2000 by Scriptics Corporation\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
+// 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/tk/win/rc/wish.ico b/tk/win/rc/wish.ico
index a32e749fd55..182575166f5 100644
--- a/tk/win/rc/wish.ico
+++ b/tk/win/rc/wish.ico
Binary files differ
diff --git a/tk/win/rc/wish.rc b/tk/win/rc/wish.rc
index 76cf1240372..5505c7b2c6a 100644
--- a/tk/win/rc/wish.rc
+++ b/tk/win/rc/wish.rc
@@ -1,7 +1,8 @@
-// SCCS: @(#) wish.rc 1.15 96/09/17 13:24:11
+// RCS: @(#) $Id$
//
// Version
//
+#include <windows.h>
#define RESOURCE_INCLUDED
#include <tk.h>
@@ -24,9 +25,9 @@ BEGIN
BEGIN
VALUE "FileDescription", "Wish Application\0"
VALUE "OriginalFilename", "wish" STRINGIFY(TK_MAJOR_VERSION) STRINGIFY(TK_MINOR_VERSION) ".exe\0"
- VALUE "CompanyName", "Sun Microsystems, Inc.\0"
+ VALUE "CompanyName", "Scriptics Corporation\0"
VALUE "FileVersion", TK_PATCH_LEVEL
- VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
+ VALUE "LegalCopyright", "Copyright \251 2000 by Scriptics Corporation\0"
VALUE "ProductName", "Tk " TK_VERSION " for Windows\0"
VALUE "ProductVersion", TK_PATCH_LEVEL
END
@@ -42,3 +43,5 @@ END
//
wish ICON DISCARDABLE "wish.ico"
+
+
diff --git a/tk/win/rc/wish_static.rc b/tk/win/rc/wish_static.rc
new file mode 100644
index 00000000000..80c3398a91d
--- /dev/null
+++ b/tk/win/rc/wish_static.rc
@@ -0,0 +1,177 @@
+// RCS: @(#) $Id$
+//
+// Version
+//
+#include <windows.h>
+
+#define RESOURCE_INCLUDED
+#include <tk.h>
+
+#define STRINGIFY1(x) #x
+#define STRINGIFY(x) STRINGIFY1(x)
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ PRODUCTVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x1L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Wish Application\0"
+ VALUE "OriginalFilename", "wish" STRINGIFY(TK_MAJOR_VERSION) STRINGIFY(TK_MINOR_VERSION) ".exe\0"
+ VALUE "CompanyName", "Scriptics Corporation\0"
+ VALUE "FileVersion", TK_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 2000 by Scriptics Corporation\0"
+ VALUE "ProductName", "Tk " TK_VERSION " for Windows\0"
+ VALUE "ProductVersion", TK_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+//
+// Icon
+//
+
+wish ICON DISCARDABLE "wish.ico"
+
+
+// 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/tk/win/rmd.bat b/tk/win/rmd.bat
index 15fd8c1fabc..63bf7619ac5 100644
--- a/tk/win/rmd.bat
+++ b/tk/win/rmd.bat
@@ -23,3 +23,4 @@ if errorlevel 1 goto end
echo deleted directory %1
:end
+
diff --git a/tk/win/stubs.c b/tk/win/stubs.c
index c9b97f5550c..e827b0fe853 100644
--- a/tk/win/stubs.c
+++ b/tk/win/stubs.c
@@ -1,8 +1,4 @@
-#include <X11/X.h>
-#include <X11/Xlib.h>
-#include <stdio.h>
-#include <tkInt.h>
-#include <tkPort.h>
+#include "tk.h"
/*
* Undocumented Xlib internal function
diff --git a/tk/win/tcl.m4 b/tk/win/tcl.m4
new file mode 100644
index 00000000000..1522bbb5b09
--- /dev/null
+++ b/tk/win/tcl.m4
@@ -0,0 +1,634 @@
+#------------------------------------------------------------------------
+# SC_PATH_TCLCONFIG --
+#
+# Locate the tclConfig.sh file and perform a sanity check on
+# the Tcl compile flags
+# Currently a no-op for Windows
+#
+# Arguments:
+# PATCH_LEVEL The patch level for Tcl if any.
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tcl=...
+#
+# Sets the following vars:
+# TCL_BIN_DIR Full path to the tclConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TCLCONFIG, [
+ AC_MSG_CHECKING([the location of tclConfig.sh])
+
+# CYGNUS LOCAL
+ if test -d ../../tcl8.1/win; then
+ TCL_BIN_DIR_DEFAULT=../../tcl8.1/win
+ else
+ TCL_BIN_DIR_DEFAULT=../../tcl/win
+ fi
+# END CYGNUS LOCAL
+
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
+ if test ! -d $TCL_BIN_DIR; then
+ AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
+ fi
+ if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+ AC_MSG_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?)
+ fi
+ AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh)
+])
+
+#------------------------------------------------------------------------
+# SC_PATH_TKCONFIG --
+#
+# Locate the tkConfig.sh file
+# Currently a no-op for Windows
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tk=...
+#
+# Sets the following vars:
+# TK_BIN_DIR Full path to the tkConfig.sh file
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_PATH_TKCONFIG, [
+ AC_MSG_CHECKING([the location of tkConfig.sh])
+
+ if test -d ../../tk8.3$1/win; then
+ TK_BIN_DIR_DEFAULT=../../tk8.3$1/win
+ else
+ TK_BIN_DIR_DEFAULT=../../tk8.3/win
+ fi
+
+ AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.3 binaries from DIR],
+ TK_BIN_DIR=$withval, TK_BIN_DIR=`cd $TK_BIN_DIR_DEFAULT; pwd`)
+ if test ! -d $TK_BIN_DIR; then
+ AC_MSG_ERROR(Tk directory $TK_BIN_DIR does not exist)
+ fi
+ if test ! -f $TK_BIN_DIR/tkConfig.sh; then
+ AC_MSG_ERROR(There is no tkConfig.sh in $TK_BIN_DIR: perhaps you did not specify the Tk *build* directory (not the toplevel Tk directory) or you forgot to configure Tk?)
+ fi
+
+ AC_MSG_RESULT([$TK_BIN_DIR/tkConfig.sh])
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TCLCONFIG --
+#
+# Load the tclConfig.sh file
+# Currently a no-op for Windows
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TCL_BIN_DIR
+#
+# Results:
+#
+# Subst the following vars:
+# TCL_BIN_DIR
+# TCL_SRC_DIR
+# TCL_LIB_FILE
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TCLCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCL_BIN_DIR/tclConfig.sh])
+
+ if test -f "$TCL_BIN_DIR/tclConfig.sh" ; then
+ AC_MSG_RESULT([loading])
+ . $TCL_BIN_DIR/tclConfig.sh
+ else
+ AC_MSG_RESULT([file not found])
+ fi
+
+ # The eval is required to do the TCL_DBGX substitution in the
+ # TCL_LIB_FILE variable.
+
+ eval TCL_LIB_FILE=${TCL_LIB_FILE}
+ eval TCL_LIB_FLAG=${TCL_LIB_FLAG}
+
+ AC_SUBST(TCL_BIN_DIR)
+ AC_SUBST(TCL_SRC_DIR)
+ AC_SUBST(TCL_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_LOAD_TKCONFIG --
+#
+# Load the tkConfig.sh file
+# Currently a no-op for Windows
+#
+# Arguments:
+#
+# Requires the following vars to be set:
+# TK_BIN_DIR
+#
+# Results:
+#
+# Sets the following vars that should be in tkConfig.sh:
+# TK_BIN_DIR
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_LOAD_TKCONFIG, [
+ AC_MSG_CHECKING([for existence of $TCLCONFIG])
+
+ if test -f "$TK_BIN_DIR/tkConfig.sh" ; then
+ AC_MSG_CHECKING([loading $TK_BIN_DIR/tkConfig.sh])
+ . $TK_BIN_DIR/tkConfig.sh
+ else
+ AC_MSG_RESULT([could not find $TK_BIN_DIR/tkConfig.sh])
+ fi
+
+
+ AC_SUBST(TK_BIN_DIR)
+ AC_SUBST(TK_SRC_DIR)
+ AC_SUBST(TK_LIB_FILE)
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SHARED --
+#
+# Allows the building of shared libraries
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-shared=yes|no
+#
+# Defines the following vars:
+# STATIC_BUILD Used for building import/export libraries
+# on Windows.
+#
+# Sets the following vars:
+# SHARED_BUILD Value of 1 or 0
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SHARED, [
+ AC_MSG_CHECKING([how to build libraries])
+ AC_ARG_ENABLE(shared,
+ [ --enable-shared build and link with shared libraries [--enable-shared]],
+ [tcl_ok=$enableval], [tcl_ok=yes])
+
+ if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ tcl_ok=$enableval
+ else
+ tcl_ok=yes
+ fi
+
+ if test "$tcl_ok" = "yes" ; then
+ AC_MSG_RESULT([shared])
+ SHARED_BUILD=1
+ else
+ AC_MSG_RESULT([static])
+ SHARED_BUILD=0
+ AC_DEFINE(STATIC_BUILD)
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_THREADS --
+#
+# Specify if thread support should be enabled
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-threads=yes|no
+#
+# Defines the following vars:
+# TCL_THREADS
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_THREADS, [
+ AC_MSG_CHECKING(for building with threads)
+ AC_ARG_ENABLE(threads, [ --enable-threads build with threads],
+ [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "$tcl_ok" = "yes"; then
+ AC_MSG_RESULT(yes)
+ TCL_THREADS=1
+ AC_DEFINE(TCL_THREADS)
+ else
+ TCL_THREADS=0
+ AC_MSG_RESULT([no (default)])
+ fi
+])
+
+#------------------------------------------------------------------------
+# SC_ENABLE_SYMBOLS --
+#
+# Specify if debugging symbols should be used
+#
+# Arguments:
+# none
+#
+# Requires the following vars to be set in the Makefile:
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+# LDFLAGS_DEBUG
+# LDFLAGS_OPTIMIZE
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --enable-symbols
+#
+# Defines the following vars:
+# CFLAGS_DEFAULT Set to $(CFLAGS_DEBUG) if true
+# Set to $(CFLAGS_OPTIMIZE) if false
+# LDFLAGS_DEFAULT Set to $(LDFLAGS_DEBUG) if true
+# Set to $(LDFLAGS_OPTIMIZE) if false
+# DBGX Debug library extension
+#
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_ENABLE_SYMBOLS, [
+ AC_MSG_CHECKING([for build with symbols])
+ AC_ARG_ENABLE(symbols, [ --enable-symbols build with debugging symbols [--disable-symbols]], [tcl_ok=$enableval], [tcl_ok=no])
+
+ if test "$tcl_ok" = "yes"; then
+ CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
+ DBGX=d
+ AC_MSG_RESULT([yes])
+ else
+ CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
+ LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
+ DBGX=""
+ AC_MSG_RESULT([no])
+ fi
+])
+
+
+#--------------------------------------------------------------------
+# SC_CONFIG_CFLAGS
+#
+# Try to determine the proper flags to pass to the compiler
+# for building shared libraries and other such nonsense.
+#
+# NOTE: The backslashes in quotes below are substituted twice
+# due to the fact that they are in a macro and then inlined
+# in the final configure script.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Can set the following vars:
+# EXTRA_CFLAGS
+# CFLAGS_DEBUG
+# CFLAGS_OPTIMIZE
+# CFLAGS_WARNING
+# LDFLAGS_DEBUG
+# LDFLAGS_OPTIMIZE
+# LDFLAGS_CONSOLE
+# LDFLAGS_WINDOW
+# CC_OBJNAME
+# CC_EXENAME
+# CYGPATH
+# STLIB_LD
+# SHLIB_LD
+# SHLIB_LD_LIBS
+# LIBS
+# AR
+# RC
+# RES
+#
+# MAKE_LIB
+# MAKE_EXE
+# MAKE_DLL
+#
+# LIBSUFFIX
+# LIBPREFIX
+# VENDORPREFIX
+# LIBRARIES
+# EXESUFFIX
+# DLLSUFFIX
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_CONFIG_CFLAGS, [
+ TCL_LIB_VERSIONS_OK=nodots
+
+ AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)
+
+ # Check for a bug in gcc's windres that causes the
+ # compile to fail when a Windows native path is
+ # passed into windres. The mingw toolchain requires
+ # Windows native paths while Cygwin should work
+ # with both. Avoid the bug by passing a POSIX
+ # path when using the Cygwin toolchain.
+
+ if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
+ conftest=/tmp/conftest.rc
+ echo "STRINGTABLE BEGIN" > $conftest
+ echo "101 \"name\"" >> $conftest
+ echo "END" >> $conftest
+
+ AC_MSG_CHECKING([for Windows native path bug in windres])
+ cyg_conftest=`$CYGPATH $conftest`
+ if AC_TRY_COMMAND($RC -o conftest.res.o $cyg_conftest) ; then
+ AC_MSG_RESULT([no])
+ else
+ AC_MSG_RESULT([yes])
+ CYGPATH=echo
+ fi
+ conftest=
+ cyg_conftest=
+ fi
+
+ if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
+ DEPARG='"$<"'
+ else
+ DEPARG='"$(shell $(CYGPATH) $<)"'
+ fi
+
+ VENDORPREFIX=""
+
+ # set various compiler flags depending on whether we are using gcc or cl
+
+ AC_MSG_CHECKING([compiler flags])
+ if test "${GCC}" = "yes" ; then
+
+ # CYGNUS LOCAL
+ VENDORPREFIX="cyg"
+
+ SHLIB_LD=""
+ SHLIB_LD_LIBS=""
+ LIBS=""
+ LIBS_GUI="-lgdi32 -lcomdlg32"
+ STLIB_LD="${AR} cr"
+ RC_OUT=-o
+ RC_TYPE=
+ RC_INCLUDE=--include
+ RES=res.o
+ MAKE_LIB="\${STLIB_LD} \[$]@"
+ POST_MAKE_LIB="\${RANLIB} \[$]@"
+ MAKE_EXE="\${CC} -o \[$]@"
+ LIBPREFIX="lib${VENDORPREFIX}"
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ AC_MSG_RESULT([using static flags])
+ runtime=
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.a"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ AC_MSG_RESULT([using shared flags])
+
+ # ad-hoc check to see if CC supports -shared.
+ if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
+ AC_MSG_ERROR([${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain.])
+ fi
+
+ runtime=
+ # Link with gcc since ld does not link to default libs like
+ # -luser32 and -lmsvcrt. We also need to add CFLAGS so important
+ # flags like -mno-cygwin get passed in to CC.
+ SHLIB_LD='${CC} -shared ${CFLAGS}'
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
+ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)"
+
+ LIBSUFFIX="\${DBGX}.a"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ CFLAGS_DEBUG=-g
+ CFLAGS_OPTIMIZE=-O
+ CFLAGS_WARNING="-Wall -Wconversion"
+ LDFLAGS_DEBUG=
+ LDFLAGS_OPTIMIZE=
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-o \[$]@"
+ CC_EXENAME="-o \[$]@"
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ #
+ # We need to pass -e _WinMain@16 so that ld will use
+ # WinMain() instead of main() as the entry point. We can't
+ # use autoconf to check for this case since it would need
+ # to run an executable and that does not work when
+ # cross compiling. Remove this -e workaround once we
+ # require a gcc that does not have this bug.
+ LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
+ LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
+ else
+ # CYGNUS LOCAL
+ VENDORPREFIX="sn"
+
+ SHLIB_LD="link -dll -nologo"
+ SHLIB_LD_LIBS="user32.lib advapi32.lib"
+ LIBS="user32.lib advapi32.lib"
+ LIBS_GUI="gdi32.lib comdlg32.lib"
+ STLIB_LD="lib -nologo"
+ RC="rc"
+ RC_OUT=-fo
+ RC_TYPE=-r
+ RC_INCLUDE=-i
+ RES=res
+ MAKE_LIB="\${STLIB_LD} -out:\[$]@"
+ POST_MAKE_LIB=
+ MAKE_EXE="\${CC} -Fe\[$]@"
+ LIBPREFIX=${VENDORPREFIX}
+
+ if test "${SHARED_BUILD}" = "0" ; then
+ # static
+ AC_MSG_RESULT([using static flags])
+ runtime=-MT
+ MAKE_DLL="echo "
+ LIBSUFFIX="s\${DBGX}.lib"
+ LIBRARIES="\${STATIC_LIBRARIES}"
+ EXESUFFIX="s\${DBGX}.exe"
+ DLLSUFFIX=""
+ else
+ # dynamic
+ AC_MSG_RESULT([using shared flags])
+ runtime=-MD
+ # Add SHLIB_LD_LIBS to the Make rule, not here.
+ MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
+ LIBSUFFIX="\${DBGX}.lib"
+ DLLSUFFIX="\${DBGX}.dll"
+ EXESUFFIX="\${DBGX}.exe"
+ LIBRARIES="\${SHARED_LIBRARIES}"
+ fi
+
+ EXTRA_CFLAGS="-YX"
+ CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
+# CFLAGS_OPTIMIZE="-nologo -O2 -Gs -GD ${runtime}"
+ CFLAGS_OPTIMIZE="-nologo -Oti -Gs -GD ${runtime}"
+ CFLAGS_WARNING="-W3"
+ LDFLAGS_DEBUG="-debug:full -debugtype:cv"
+ LDFLAGS_OPTIMIZE="-release"
+
+ # Specify the CC output file names based on the target name
+ CC_OBJNAME="-Fo\[$]@"
+ CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\""
+
+ # Specify linker flags depending on the type of app being
+ # built -- Console vs. Window.
+ LDFLAGS_CONSOLE="-link -subsystem:console"
+ LDFLAGS_WINDOW="-link -subsystem:windows"
+ fi
+
+ # TCL_LIB_SUFFIX is defined here and in tclConfig.sh so that macros
+ # can use a single variable name for both Tcl and extensions.
+ TCL_LIB_SUFFIX=$LIBSUFFIX
+])
+
+#------------------------------------------------------------------------
+# SC_WITH_TCL --
+#
+# Location of the Tcl build directory.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Adds the following arguments to configure:
+# --with-tcl=...
+#
+# Defines the following vars:
+# TCL_BIN_DIR Full path to the tcl build dir.
+#------------------------------------------------------------------------
+
+AC_DEFUN(SC_WITH_TCL, [
+ if test -d ../../tcl8.3$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.3$1/win
+ else
+ TCL_BIN_DEFAULT=../../tcl8.3/win
+ fi
+
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.3 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
+ if test ! -d $TCL_BIN_DIR; then
+ AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
+ fi
+ if test ! -f $TCL_BIN_DIR/Makefile; then
+ AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR: perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+ else
+ echo "building against Tcl binaries in: $TCL_BIN_DIR"
+ fi
+ AC_SUBST(TCL_BIN_DIR)
+])
+
+#--------------------------------------------------------------------
+# SC_TIME_HANLDER
+#
+# Checks how the system deals with time.h, what time structures
+# are used on the system, and what fields the structures have.
+#
+# Arguments:
+# none
+#
+# Results:
+#
+# Defines some of the following vars:
+# USE_DELTA_FOR_TZ
+# HAVE_TM_GMTOFF
+# HAVE_TM_TZADJ
+# HAVE_TIMEZONE_VAR
+#
+#--------------------------------------------------------------------
+
+AC_DEFUN(SC_TIME_HANDLER, [
+ AC_CHECK_HEADERS(sys/time.h)
+ AC_HEADER_TIME
+ AC_STRUCT_TIMEZONE
+
+ AC_MSG_CHECKING([tm_tzadj in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
+ [AC_DEFINE(HAVE_TM_TZADJ)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ AC_MSG_CHECKING([tm_gmtoff in struct tm])
+ AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_gmtoff;],
+ [AC_DEFINE(HAVE_TM_GMTOFF)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # Its important to include time.h in this check, as some systems
+ # (like convex) have timezone functions, etc.
+ #
+ have_timezone=no
+ AC_MSG_CHECKING([long timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern long timezone;
+ timezone += 1;
+ exit (0);],
+ [have_timezone=yes
+ AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+
+ #
+ # On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
+ #
+ if test "$have_timezone" = no; then
+ AC_MSG_CHECKING([time_t timezone variable])
+ AC_TRY_COMPILE([#include <time.h>],
+ [extern time_t timezone;
+ timezone += 1;
+ exit (0);],
+ [AC_DEFINE(HAVE_TIMEZONE_VAR)
+ AC_MSG_RESULT(yes)],
+ AC_MSG_RESULT(no))
+ fi
+
+ #
+ # On some systems (eg Solaris 2.5.1), timezone is not declared in
+ # time.h unless you jump through hoops. Instead of that, we just
+ # declare it ourselves when necessary.
+ #
+ if test "$have_timezone" = yes; then
+ AC_MSG_CHECKING(for timezone declaration)
+ changequote(<<,>>)
+ tzrx='^[ ]*extern.*timezone'
+ changequote([,])
+ AC_EGREP_HEADER($tzrx, time.h, [
+ AC_DEFINE(HAVE_TIMEZONE_DECL)
+ AC_MSG_RESULT(found)], AC_MSG_RESULT(missing))
+ fi
+
+ #
+ # AIX does not have a timezone field in struct tm. When the AIX bsd
+ # library is used, the timezone global and the gettimeofday methods are
+ # to be avoided for timezone deduction instead, we deduce the timezone
+ # by comparing the localtime result on a known GMT value.
+ #
+
+ if test "`uname -s`" = "AIX" ; then
+ AC_CHECK_LIB(bsd, gettimeofday, libbsd=yes)
+ if test $libbsd = yes; then
+ AC_DEFINE(USE_DELTA_FOR_TZ)
+ fi
+ fi
+])
+
diff --git a/tk/win/tkConfig.sh.in b/tk/win/tkConfig.sh.in
new file mode 100644
index 00000000000..3e2dbf33846
--- /dev/null
+++ b/tk/win/tkConfig.sh.in
@@ -0,0 +1,92 @@
+# 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@'
+LIBS_GUI='@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@'
+
+# -I switch(es) to use to make all of the X11 include files accessible:
+TK_XINCLUDES='@XINCLUDES@'
+
+# -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/tk/win/tkWin.h b/tk/win/tkWin.h
index 40e7a24bb9d..f92ec8d322c 100644
--- a/tk/win/tkWin.h
+++ b/tk/win/tkWin.h
@@ -4,7 +4,7 @@
* Declarations of public types and interfaces that are only
* available under Windows.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * 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.
@@ -47,18 +47,10 @@
*--------------------------------------------------------------
*/
-EXTERN Window Tk_AttachHWND _ANSI_ARGS_((Tk_Window tkwin,
- HWND hwnd));
-EXTERN HINSTANCE Tk_GetHINSTANCE _ANSI_ARGS_((void));
-EXTERN HWND Tk_GetHWND _ANSI_ARGS_((Window window));
-EXTERN Tk_Window Tk_HWNDToWindow _ANSI_ARGS_((HWND hwnd));
-EXTERN void Tk_PointerEvent _ANSI_ARGS_((HWND hwnd,
- int x, int y));
-EXTERN int Tk_TranslateWinEvent _ANSI_ARGS_((HWND hwnd,
- UINT message, WPARAM wParam, LPARAM lParam,
- LRESULT *result));
+#include "tkPlatDecls.h"
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKWIN */
+
diff --git a/tk/win/tkWin32Dll.c b/tk/win/tkWin32Dll.c
index 7c2fec7c3b4..48fdd0ac671 100644
--- a/tk/win/tkWin32Dll.c
+++ b/tk/win/tkWin32Dll.c
@@ -11,7 +11,6 @@
* RCS: @(#) $Id$
*/
-#include "tkPort.h"
#include "tkWinInt.h"
/*
@@ -25,7 +24,7 @@ BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
/* cygwin32 requires an impure pointer variable, which must be
explicitly initialized when the DLL starts up. */
struct _reent *_impure_ptr;
-extern struct _reent *_imp__reent_data;
+extern struct _reent __declspec(dllimport) reent_data;
#endif
/* END CYGNUS LOCAL */
@@ -78,11 +77,10 @@ DllMain(hInstance, reason, reserved)
DWORD reason;
LPVOID reserved;
{
- /* CYGNUS LOCAL */
#ifdef __CYGWIN32__
/* cygwin32 requires the impure data pointer to be initialized
when the DLL starts up. */
- _impure_ptr = _imp__reent_data;
+ _impure_ptr = &reent_data;
#endif
/* END CYGNUS LOCAL */
@@ -99,3 +97,4 @@ DllMain(hInstance, reason, reserved)
}
return(TRUE);
}
+
diff --git a/tk/win/tkWin3d.c b/tk/win/tkWin3d.c
index 9e0bd586530..35d71c81f1d 100644
--- a/tk/win/tkWin3d.c
+++ b/tk/win/tkWin3d.c
@@ -12,8 +12,8 @@
* RCS: @(#) $Id$
*/
-#include <tk3d.h>
-#include <tkWinInt.h>
+#include "tkWinInt.h"
+#include "tk3d.h"
/*
* This structure is used to keep track of the extra colors used by
@@ -146,10 +146,10 @@ Tk_3DVerticalBevel(tkwin, drawable, border, x, y, width, height,
break;
case TK_RELIEF_SUNKEN:
left = (leftBevel)
- ? borderPtr->darkGC->foreground
+ ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
: ((WinBorder *)borderPtr)->light2ColorPtr->pixel;
right = (leftBevel)
- ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
+ ? borderPtr->darkGC->foreground
: borderPtr->lightGC->foreground;
break;
case TK_RELIEF_RIDGE:
@@ -247,10 +247,10 @@ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, height,
break;
case TK_RELIEF_SUNKEN:
topColor = (topBevel)
- ? borderPtr->darkGC->foreground
+ ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
: ((WinBorder *)borderPtr)->light2ColorPtr->pixel;
bottomColor = (topBevel)
- ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
+ ? borderPtr->darkGC->foreground
: borderPtr->lightGC->foreground;
break;
case TK_RELIEF_RIDGE:
@@ -342,6 +342,7 @@ TkpGetShadows(borderPtr, tkwin)
{
XColor lightColor, darkColor;
int tmp1, tmp2;
+ int r, g, b;
XGCValues gcValues;
if (borderPtr->lightGC != None) {
@@ -392,42 +393,81 @@ TkpGetShadows(borderPtr, tkwin)
/*
* 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
*/
- darkColor.red = (60 * (int) borderPtr->bgColorPtr->red)/100;
- darkColor.green = (60 * (int) borderPtr->bgColorPtr->green)/100;
- darkColor.blue = (60 * (int) borderPtr->bgColorPtr->blue)/100;
borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
gcValues.foreground = borderPtr->darkColorPtr->pixel;
borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
/*
- * Compute the colors using integers, not using lightColor.red
- * etc.: these are shorts and may have problems with integer
- * overflow.
+ * Compute the light shadow color
*/
- tmp1 = (14 * (int) borderPtr->bgColorPtr->red)/10;
- if (tmp1 > MAX_INTENSITY) {
- tmp1 = MAX_INTENSITY;
- }
- tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->red)/2;
- lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
- tmp1 = (14 * (int) borderPtr->bgColorPtr->green)/10;
- if (tmp1 > MAX_INTENSITY) {
- tmp1 = MAX_INTENSITY;
- }
- tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->green)/2;
- lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
- tmp1 = (14 * (int) borderPtr->bgColorPtr->blue)/10;
- if (tmp1 > MAX_INTENSITY) {
- tmp1 = MAX_INTENSITY;
+ 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;
}
- tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->blue)/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);
diff --git a/tk/win/tkWinButton.c b/tk/win/tkWinButton.c
index 3335d66d88b..6b4da6ecc1c 100644
--- a/tk/win/tkWinButton.c
+++ b/tk/win/tkWinButton.c
@@ -4,7 +4,7 @@
* This file implements the Windows specific portion of the button
* widgets.
*
- * Copyright (c) 1996 by Sun Microsystems, Inc.
+ * 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.
@@ -66,26 +66,20 @@ enum {
};
/*
- * Set to non-zero if this module is initialized.
+ * 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.
*/
-static int initialized = 0;
-
-/*
- * Variables for the cached information about the boxes bitmap.
- */
-
-static BITMAPINFOHEADER *boxesPtr = NULL; /* Information about the bitmap. */
-static DWORD *boxesPalette = NULL; /* Pointer to color palette. */
-static LPSTR boxesBits = NULL; /* Pointer to bitmap data. */
-static DWORD boxHeight = 0, boxWidth = 0; /* Size of each sub-image. */
-
-/*
- * This variable holds the default border width for a button in string
- * form for use in a Tk_ConfigSpec.
- */
-
-static char defWidth[8];
+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.
@@ -100,7 +94,6 @@ static DWORD ComputeStyle _ANSI_ARGS_((WinButton* butPtr));
static Window CreateProc _ANSI_ARGS_((Tk_Window tkwin,
Window parent, ClientData instanceData));
static void InitBoxes _ANSI_ARGS_((void));
-static void UpdateButtonDefaults _ANSI_ARGS_((void));
/* CYGNUS LOCAL. */
static void TkpRealDisplayButton _ANSI_ARGS_((ClientData, int));
@@ -150,65 +143,75 @@ InitBoxes()
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);
- boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk);
+ tsdPtr->boxesPtr = (LPBITMAPINFOHEADER)LockResource(hblk);
}
/*
* Copy the DIBitmap into writable memory.
*/
- if (boxesPtr != NULL && !(boxesPtr->biWidth % 4)
- && !(boxesPtr->biHeight % 2)) {
- size = boxesPtr->biSize + (1 << boxesPtr->biBitCount) * sizeof(RGBQUAD)
- + boxesPtr->biSizeImage;
+ 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, boxesPtr, size);
- boxesPtr = newBitmap;
- boxWidth = boxesPtr->biWidth / 4;
- boxHeight = boxesPtr->biHeight / 2;
- boxesPalette = (DWORD*) (((LPSTR)boxesPtr) + boxesPtr->biSize);
- boxesBits = ((LPSTR)boxesPalette)
- + ((1 << boxesPtr->biBitCount) * sizeof(RGBQUAD));
+ 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 {
- boxesPtr = NULL;
+ tsdPtr->boxesPtr = NULL;
}
}
/*
*----------------------------------------------------------------------
*
- * UpdateButtonDefaults --
+ * TkpButtonSetDefaults --
*
- * This function retrieves the current system defaults for
- * the button widgets.
+ * 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:
- * None.
+ * Some of the default values in *specPtr are modified.
*
* Side effects:
- * Updates the configuration defaults for buttons.
+ * Updates some of.
*
*----------------------------------------------------------------------
*/
void
-UpdateButtonDefaults()
+TkpButtonSetDefaults(specPtr)
+ Tk_OptionSpec *specPtr; /* Points to an array of option specs,
+ * terminated by one with type
+ * TK_OPTION_END. */
{
- Tk_ConfigSpec *specPtr;
- int width = GetSystemMetrics(SM_CXEDGE);
-
- if (width == 0) {
- width = 1;
+ 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);
}
- sprintf(defWidth, "%d", width);
- for (specPtr = tkpButtonConfigSpecs; specPtr->type != TK_CONFIG_END;
- specPtr++) {
- if (specPtr->offset == Tk_Offset(TkButton, borderWidth)) {
- specPtr->defValue = defWidth;
+ for ( ; specPtr->type != TK_OPTION_END; specPtr++) {
+ if (specPtr->internalOffset == Tk_Offset(TkButton, borderWidth)) {
+ specPtr->defValue = tsdPtr->defWidth;
}
}
}
@@ -235,11 +238,6 @@ TkpCreateButton(tkwin)
{
WinButton *butPtr;
- if (!initialized) {
- UpdateButtonDefaults();
- initialized = 1;
- }
-
butPtr = (WinButton *)ckalloc(sizeof(WinButton));
butPtr->hwnd = NULL;
/* CYGNUS LOCAL: Use the pixmap field. */
@@ -379,13 +377,12 @@ TkpRealDisplayButton(clientData, force)
* it is a flavor of button, so we offset
* the text to make the button appear to
* move up and down as the relief changes. */
+ DWORD *boxesPalette;
- /* CYGNUS LOCAL: If the generic code has asked us to draw
- ourselves, force a full refresh. */
- if ((butPtr->flags & REDRAW_PENDING) != 0) {
- force = 1;
- }
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ boxesPalette= tsdPtr->boxesPalette;
butPtr->flags &= ~REDRAW_PENDING;
if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
return;
@@ -407,16 +404,16 @@ TkpRealDisplayButton(clientData, force)
}
border = butPtr->normalBorder;
- if ((butPtr->state == tkDisabledUid) && (butPtr->disabledFg != NULL)) {
+ if ((butPtr->state == STATE_DISABLED) && (butPtr->disabledFg != NULL)) {
gc = butPtr->disabledGC;
- } else if ((butPtr->state == tkActiveUid)
+ } 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 != tkActiveUid)
+ if ((butPtr->flags & SELECTED) && (butPtr->state != STATE_ACTIVE)
&& (butPtr->selectBorder != NULL) && !butPtr->indicatorOn) {
border = butPtr->selectBorder;
}
@@ -437,7 +434,7 @@ TkpRealDisplayButton(clientData, force)
*/
if (butPtr->type == TYPE_BUTTON) {
- defaultWidth = ((butPtr->defaultState == tkActiveUid)
+ defaultWidth = ((butPtr->defaultState == DEFAULT_ACTIVE)
? butPtr->highlightWidth : 0);
offset = 1;
} else {
@@ -546,17 +543,17 @@ TkpRealDisplayButton(clientData, force)
*/
if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn
- && boxesPtr) {
+ && tsdPtr->boxesPtr) {
int xSrc, ySrc;
x -= butPtr->indicatorSpace;
y -= butPtr->indicatorDiameter / 2;
- xSrc = (butPtr->flags & SELECTED) ? boxWidth : 0;
- if (butPtr->state == tkActiveUid) {
- xSrc += boxWidth*2;
+ xSrc = (butPtr->flags & SELECTED) ? tsdPtr->boxWidth : 0;
+ if (butPtr->state == STATE_ACTIVE) {
+ xSrc += tsdPtr->boxWidth*2;
}
- ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : boxHeight;
+ ySrc = (butPtr->type == TYPE_RADIO_BUTTON) ? 0 : tsdPtr->boxHeight;
/*
* Update the palette in the boxes bitmap to reflect the current
@@ -576,7 +573,7 @@ TkpRealDisplayButton(clientData, force)
border, TK_3D_LIGHT2));
boxesPalette[PAL_BOTTOM_OUTER] = FlipColor(TkWinGetBorderPixels(tkwin,
border, TK_3D_LIGHT_GC));
- if (butPtr->state == tkDisabledUid) {
+ if (butPtr->state == STATE_DISABLED) {
boxesPalette[PAL_INTERIOR] = FlipColor(TkWinGetBorderPixels(tkwin,
border, TK_3D_LIGHT2));
} else if (butPtr->selectBorder != NULL) {
@@ -589,9 +586,10 @@ TkpRealDisplayButton(clientData, force)
border, TK_3D_FLAT_GC));
dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
- StretchDIBits(dc, x, y, boxWidth, boxHeight, xSrc, ySrc,
- boxWidth, boxHeight, boxesBits, (LPBITMAPINFO)boxesPtr,
- DIB_RGB_COLORS, SRCCOPY);
+ 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);
}
@@ -602,7 +600,7 @@ TkpRealDisplayButton(clientData, force)
* must temporarily modify the GC.
*/
- if ((butPtr->state == tkDisabledUid)
+ if ((butPtr->state == STATE_DISABLED)
&& ((butPtr->disabledFg == NULL) || (butPtr->image != NULL))) {
if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
&& (butPtr->selectBorder != NULL)) {
@@ -688,6 +686,8 @@ TkpComputeButtonGeometry(butPtr)
{
int width, height, avgWidth;
Tk_FontMetrics fm;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (butPtr->highlightWidth < 0) {
butPtr->highlightWidth = 0;
@@ -695,7 +695,7 @@ TkpComputeButtonGeometry(butPtr)
butPtr->inset = butPtr->highlightWidth + butPtr->borderWidth;
butPtr->indicatorSpace = 0;
- if (!boxesPtr) {
+ if (!tsdPtr->boxesPtr) {
InitBoxes();
}
@@ -709,8 +709,8 @@ TkpComputeButtonGeometry(butPtr)
height = butPtr->height;
}
if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
- butPtr->indicatorSpace = boxWidth * 2;
- butPtr->indicatorDiameter = boxHeight;
+ butPtr->indicatorSpace = tsdPtr->boxWidth * 2;
+ butPtr->indicatorDiameter = tsdPtr->boxHeight;
}
} else if (butPtr->bitmap != None) {
Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
@@ -718,8 +718,8 @@ TkpComputeButtonGeometry(butPtr)
} else {
Tk_FreeTextLayout(butPtr->textLayout);
butPtr->textLayout = Tk_ComputeTextLayout(butPtr->tkfont,
- butPtr->text, -1, butPtr->wrapLength, butPtr->justify, 0,
- &butPtr->textWidth, &butPtr->textHeight);
+ Tcl_GetString(butPtr->textPtr), -1, butPtr->wrapLength,
+ butPtr->justify, 0, &butPtr->textWidth, &butPtr->textHeight);
width = butPtr->textWidth;
height = butPtr->textHeight;
@@ -729,12 +729,15 @@ TkpComputeButtonGeometry(butPtr)
if (butPtr->width > 0) {
width = butPtr->width * avgWidth;
}
- if (butPtr->height > 0) {
+
+ if (butPtr->type == TYPE_BUTTON) {
+ height = butPtr->height * fm.ascent;
+ } else {
height = butPtr->height * fm.linespace;
}
if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
- butPtr->indicatorDiameter = boxHeight;
+ butPtr->indicatorDiameter = tsdPtr->boxHeight;
butPtr->indicatorSpace = butPtr->indicatorDiameter + avgWidth;
}
@@ -840,14 +843,21 @@ ButtonProc(hwnd, message, wParam, lParam)
PAINTSTRUCT ps;
BeginPaint(hwnd, &ps);
EndPaint(hwnd, &ps);
- /* CYGNUS LOCAL: Don't force the button to be recomputed. */
- TkpRealDisplayButton((ClientData)butPtr, 0);
+ 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 != tkDisabledUid) {
+ if (butPtr->info.state != STATE_DISABLED) {
Tcl_Preserve((ClientData)interp);
code = TkInvokeButton((TkButton*)butPtr);
if (code != TCL_OK && code != TCL_CONTINUE
@@ -868,3 +878,4 @@ ButtonProc(hwnd, message, wParam, lParam)
}
return DefWindowProc(hwnd, message, wParam, lParam);
}
+
diff --git a/tk/win/tkWinClipboard.c b/tk/win/tkWinClipboard.c
index d7d73d71995..df94a49aec0 100644
--- a/tk/win/tkWinClipboard.c
+++ b/tk/win/tkWinClipboard.c
@@ -3,7 +3,8 @@
*
* This file contains functions for managing the clipboard.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * 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.
@@ -14,6 +15,7 @@
#include "tkWinInt.h"
#include "tkSelect.h"
+static void UpdateClipboard _ANSI_ARGS_((HWND hwnd));
/*
*----------------------------------------------------------------------
@@ -27,7 +29,7 @@
* Results:
* The return value is a standard Tcl return value.
* If an error occurs (such as no selection exists)
- * then an error message is left in interp->result.
+ * then an error message is left in the interp's result.
*
* Side effects:
* None.
@@ -49,40 +51,126 @@ TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
* selection, once it has been retrieved. */
ClientData clientData; /* Arbitrary value to pass to proc. */
{
- char *data, *buffer, *destPtr;
+ char *data, *destPtr;
+ Tcl_DString ds;
HGLOBAL handle;
- int result, length;
-
- if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
- && (target == XA_STRING)) {
- if (OpenClipboard(NULL)) {
- handle = GetClipboardData(CF_TEXT);
- if (handle != NULL) {
- data = GlobalLock(handle);
- length = strlen(data);
- buffer = ckalloc(length+1);
- destPtr = buffer;
- while (*data != '\0') {
- if (*data != '\r') {
- *destPtr = *data;
- destPtr++;
- }
- data++;
- }
- *destPtr = '\0';
- GlobalUnlock(handle);
+ 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();
- result = (*proc)(clientData, interp, buffer);
- ckfree(buffer);
- return result;
+ 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);
+ " selection doesn't exist or form \"",
+ Tk_GetAtomName(tkwin, target),
+ "\" not defined", (char *) NULL);
return TCL_ERROR;
}
@@ -119,7 +207,7 @@ XSetSelectionOwner(display, selection, owner, time)
* It expects a Tk_Window, even though it only needs a Tk_Display.
*/
- tkwin = (Tk_Window)tkMainWindowList->winPtr;
+ tkwin = (Tk_Window) TkGetMainInfoList()->winPtr;
if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {
@@ -129,10 +217,7 @@ XSetSelectionOwner(display, selection, owner, time)
*/
if (GetClipboardOwner() != hwnd) {
- OpenClipboard(hwnd);
- EmptyClipboard();
- SetClipboardData(CF_TEXT, NULL);
- CloseClipboard();
+ UpdateClipboard(hwnd);
}
}
}
@@ -162,14 +247,21 @@ TkWinClipboardRender(dispPtr, format)
TkClipboardTarget *targetPtr;
TkClipboardBuffer *cbPtr;
HGLOBAL handle;
- char *buffer, *p, *endPtr;
+ 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;
@@ -183,11 +275,12 @@ TkWinClipboardRender(dispPtr, format)
}
}
}
- handle = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, length+1);
- if (!handle) {
- return;
- }
- buffer = GlobalLock(handle);
+
+ /*
+ * Copy the data and change EOL characters.
+ */
+
+ buffer = rawText = ckalloc(length + 1);
if (targetPtr != NULL) {
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
@@ -201,8 +294,43 @@ TkWinClipboardRender(dispPtr, format)
}
}
*buffer = '\0';
- GlobalUnlock(handle);
- SetClipboardData(CF_TEXT, handle);
+
+ /*
+ * 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;
}
@@ -229,11 +357,46 @@ TkSelUpdateClipboard(winPtr, targetPtr)
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();
- SetClipboardData(CF_TEXT, NULL);
+
+ /*
+ * 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);
}
/*
@@ -289,3 +452,5 @@ TkSelPropProc(eventPtr)
register XEvent *eventPtr; /* X PropertyChange event. */
{
}
+
+
diff --git a/tk/win/tkWinColor.c b/tk/win/tkWinColor.c
index 20dd3ed13a0..e05f0c692e0 100644
--- a/tk/win/tkWinColor.c
+++ b/tk/win/tkWinColor.c
@@ -12,8 +12,8 @@
* RCS: @(#) $Id$
*/
-#include <tkColor.h>
-#include <tkWinInt.h>
+#include "tkWinInt.h"
+#include "tkColor.h"
/*
* The following structure is used to keep track of each color that is
@@ -27,12 +27,6 @@ typedef struct WinColor {
} WinColor;
/*
- * colorTable is a hash table used to look up X colors by name.
- */
-
-static Tcl_HashTable colorTable;
-
-/*
* The sysColors array contains the names and index values for the
* Windows indirect system color names. In use, all of the names
* will have the string "System" prepended, but we omit it in the table
@@ -75,7 +69,10 @@ static SystemColorEntry sysColors[] = {
NULL, 0
};
-static int ncolors = 0;
+typedef struct ThreadSpecificData {
+ int ncolors;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* Forward declarations for functions defined later in this file.
@@ -111,13 +108,15 @@ FindSystemColor(name, colorPtr, indexPtr)
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 (ncolors == 0) {
+ if (tsdPtr->ncolors == 0) {
SystemColorEntry *ePtr;
int version;
@@ -130,7 +129,7 @@ FindSystemColor(name, colorPtr, indexPtr)
ePtr->index = COLOR_BTNHIGHLIGHT;
}
}
- ncolors++;
+ tsdPtr->ncolors++;
}
}
@@ -139,7 +138,7 @@ FindSystemColor(name, colorPtr, indexPtr)
*/
l = 0;
- u = ncolors - 1;
+ u = tsdPtr->ncolors - 1;
while (l <= u) {
i = (l + u) / 2;
r = strcasecmp(name, sysColors[i].name);
@@ -157,9 +156,13 @@ FindSystemColor(name, colorPtr, indexPtr)
*indexPtr = sysColors[i].index;
colorPtr->pixel = GetSysColor(sysColors[i].index);
- colorPtr->red = GetRValue(colorPtr->pixel) << 8;
- colorPtr->green = GetGValue(colorPtr->pixel) << 8;
- colorPtr->blue = GetBValue(colorPtr->pixel) << 8;
+ /*
+ * 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;
@@ -339,7 +342,7 @@ XAllocColor(display, colormap, 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;
@@ -374,9 +377,9 @@ XAllocColor(display, colormap, color)
if ((index >= cmap->size) || (newPixel != closePixel)) {
if (cmap->size == sizePalette) {
- color->red = closeEntry.peRed << 8;
- color->green = closeEntry.peGreen << 8;
- color->blue = closeEntry.peBlue << 8;
+ 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");
@@ -405,9 +408,9 @@ XAllocColor(display, colormap, color)
color->pixel = GetNearestColor(dc,
RGB(entry.peRed, entry.peGreen, entry.peBlue));
- color->red = (GetRValue(color->pixel) << 8);
- color->green = (GetGValue(color->pixel) << 8);
- color->blue = (GetBValue(color->pixel) << 8);
+ color->red = GetRValue(color->pixel) * 257;
+ color->green = GetGValue(color->pixel) * 257;
+ color->blue = GetBValue(color->pixel) * 257;
}
ReleaseDC(NULL, dc);
@@ -613,31 +616,3 @@ TkWinSelectPalette(dc, colormap)
RealizePalette(dc);
return oldPalette;
}
-
-/* CYGNUS LOCAL: The system colors have changed. Update them. */
-
-static void
-ChangeColor(tkColPtr)
- TkColor *tkColPtr;
-{
- WinColor *winColPtr = (WinColor *) tkColPtr;
-
- if (winColPtr->index != -1) {
- unsigned long pixel;
-
- pixel = GetSysColor(winColPtr->index);
- if (pixel != winColPtr->info.color.pixel) {
- winColPtr->info.color.pixel = pixel;
- winColPtr->info.color.red = GetRValue(pixel) << 8;
- winColPtr->info.color.green = GetGValue(pixel) << 8;
- winColPtr->info.color.blue = GetBValue(pixel) << 8;
- TkColorChanged((TkColor *) winColPtr);
- }
- }
-}
-
-void
-TkWinSysColorChange()
-{
- TkMapOverColors(ChangeColor);
-}
diff --git a/tk/win/tkWinConfig.c b/tk/win/tkWinConfig.c
new file mode 100644
index 00000000000..c8c4f76cf55
--- /dev/null
+++ b/tk/win/tkWinConfig.c
@@ -0,0 +1,61 @@
+/*
+ * 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. */
+ char *dbName, /* The option database name. */
+ char *className) /* The name of the option class. */
+{
+ Tcl_Obj *valueObjPtr;
+ Tk_Uid classUid;
+
+ if (tkwin == NULL) {
+ return NULL;
+ }
+
+ valueObjPtr = NULL;
+ classUid = Tk_Class(tkwin);
+
+ if (strcmp(classUid, "Menu") == 0) {
+ valueObjPtr = TkWinGetMenuSystemDefault(tkwin, dbName, className);
+ }
+
+ return valueObjPtr;
+}
+
diff --git a/tk/win/tkWinCursor.c b/tk/win/tkWinCursor.c
index 33c5ef9c213..6ed11a7a90d 100644
--- a/tk/win/tkWinCursor.c
+++ b/tk/win/tkWinCursor.c
@@ -109,7 +109,36 @@ TkGetCursorByName(interp, tkwin, string)
cursorPtr->winCursor = LoadCursor(Tk_GetHINSTANCE(), string);
cursorPtr->system = 0;
}
+ if (string[0] == '@') {
+ int argc;
+ char **argv = NULL;
+ if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ return NULL;
+ }
+ /*
+ * Check for system cursor of type @<filename>, where only
+ * the name is allowed. This accepts either:
+ * -cursor @/winnt/cursors/globe.ani
+ * -cursor @C:/Winnt/cursors/E_arrow.cur
+ * -cursor {@C:/Program\ Files/Cursors/bart.ani}
+ */
+ if ((argc != 1) || (argv[0][0] != '@')) {
+ ckfree((char *) argv);
+ goto badCursorSpec;
+ }
+ 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]));
+ cursorPtr->system = 0;
+ ckfree((char *) argv);
+ }
if (cursorPtr->winCursor == NULL) {
+ badCursorSpec:
ckfree((char *)cursorPtr);
Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
(char *) NULL);
@@ -152,7 +181,7 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
/*
*----------------------------------------------------------------------
*
- * TkFreeCursor --
+ * TkpFreeCursor --
*
* This procedure is called to release a cursor allocated by
* TkGetCursorByName.
@@ -167,11 +196,10 @@ TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
*/
void
-TkFreeCursor(cursorPtr)
+TkpFreeCursor(cursorPtr)
TkCursor *cursorPtr;
{
TkWinCursor *winCursorPtr = (TkWinCursor *) cursorPtr;
- ckfree((char *) winCursorPtr);
}
/*
@@ -208,3 +236,4 @@ TkpSetCursor(cursor)
SetCursor(hcursor);
}
}
+
diff --git a/tk/win/tkWinDefault.h b/tk/win/tkWinDefault.h
index 65ea546d659..3860cce0a33 100644
--- a/tk/win/tkWinDefault.h
+++ b/tk/win/tkWinDefault.h
@@ -65,7 +65,8 @@
#define DEF_CHKRAD_FG TEXT_FG
#define DEF_BUTTON_FONT CTL_FONT
#define DEF_BUTTON_HEIGHT "0"
-#define DEF_BUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_BUTTON_HIGHLIGHT_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"
@@ -76,7 +77,7 @@
#define DEF_BUTTON_ON_VALUE "1"
#define DEF_BUTTON_PADX "1"
#define DEF_LABCHKRAD_PADX "1"
-#define DEF_BUTTON_PADY "1"
+#define DEF_BUTTON_PADY "4.5"
#define DEF_LABCHKRAD_PADY "1"
#define DEF_BUTTON_RELIEF "raised"
#define DEF_LABCHKRAD_RELIEF "flat"
@@ -203,6 +204,7 @@
#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"
@@ -288,7 +290,8 @@
#define DEF_MENUBUTTON_FONT CTL_FONT
#define DEF_MENUBUTTON_FG NORMAL_FG
#define DEF_MENUBUTTON_HEIGHT "0"
-#define DEF_MENUBUTTON_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MENUBUTTON_HIGHLIGHT_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
@@ -347,7 +350,8 @@
#define DEF_SCALE_FG_COLOR NORMAL_FG
#define DEF_SCALE_FG_MONO BLACK
#define DEF_SCALE_FROM "0"
-#define DEF_SCALE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCALE_HIGHLIGHT_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 ""
@@ -455,3 +459,4 @@
#define DEF_TOPLEVEL_SCREEN ""
#endif /* _TKWINDEFAULT */
+
diff --git a/tk/win/tkWinDialog.c b/tk/win/tkWinDialog.c
index d2229d6bf56..3d0b2e1fddd 100644
--- a/tk/win/tkWinDialog.c
+++ b/tk/win/tkWinDialog.c
@@ -1,3 +1,4 @@
+
/*
* tkWinDialog.c --
*
@@ -11,7 +12,7 @@
* RCS: @(#) $Id$
*
*/
-
+
#include "tkWinInt.h"
#include "tkFileFilter.h"
@@ -19,138 +20,144 @@
#include <dlgs.h> /* includes common dialog template defines */
#include <cderr.h> /* includes the common dialog error codes */
-#if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION <= 2))
+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 function is implemented on tk4.3 and after only
+ * The following structures are used by Tk_MessageBoxCmd() to parse
+ * arguments and return results.
*/
-#define Tk_GetHWND TkWinGetHWND
-#endif
-#define SAVE_FILE 0
-#define OPEN_FILE 1
+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}
+};
-/*----------------------------------------------------------------------
- * MsgTypeInfo --
- *
- * This structure stores the type of available message box in an
- * easy-to-process format. Used by th Tk_MessageBox() function
- *----------------------------------------------------------------------
- */
-typedef struct MsgTypeInfo {
- char * name;
- int type;
- int numButtons;
- char * btnNames[3];
-} MsgTypeInfo;
-
-#define NUM_TYPES 6
-
-static MsgTypeInfo
-msgTypeInfo[NUM_TYPES] = {
- {"abortretryignore", MB_ABORTRETRYIGNORE, 3, {"abort", "retry", "ignore"}},
- {"ok", MB_OK, 1, {"ok" }},
- {"okcancel", MB_OKCANCEL, 2, {"ok", "cancel" }},
- {"retrycancel", MB_RETRYCANCEL, 2, {"retry", "cancel" }},
- {"yesno", MB_YESNO, 2, {"yes", "no" }},
- {"yesnocancel", MB_YESNOCANCEL, 3, {"yes", "no", "cancel"}}
+static const TkStateMap buttonMap[] = {
+ {IDABORT, "abort"},
+ {IDRETRY, "retry"},
+ {IDIGNORE, "ignore"},
+ {IDOK, "ok"},
+ {IDCANCEL, "cancel"},
+ {IDNO, "no"},
+ {IDYES, "yes"},
+ {-1, NULL}
};
+static const int buttonFlagMap[] = {
+ MB_DEFBUTTON1, MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4
+};
+
+static const struct {int type; int btnIds[3];} allowedTypes[] = {
+ {MB_ABORTRETRYIGNORE, {IDABORT, IDRETRY, IDIGNORE}},
+ {MB_OK, {IDOK, -1, -1 }},
+ {MB_OKCANCEL, {IDOK, IDCANCEL, -1 }},
+ {MB_RETRYCANCEL, {IDRETRY, IDCANCEL, -1 }},
+ {MB_YESNO, {IDYES, IDNO, -1 }},
+ {MB_YESNOCANCEL, {IDYES, IDNO, IDCANCEL}}
+};
+
+#define NUM_TYPES (sizeof(allowedTypes) / sizeof(allowedTypes[0]))
+
/*
- * The following structure is used in the GetOpenFileName() and
- * GetSaveFileName() calls.
+ * The following structure is used to pass information between the directory
+ * chooser procedure, Tk_ChooseDirectoryObjCmd(), and its dialog hook proc.
*/
-typedef struct _OpenFileData {
- Tcl_Interp * interp;
- TCHAR szFile[(256*MAX_PATH)+1];
-} OpenFileData;
+
+typedef struct ChooseDir {
+ Tcl_Interp *interp; /* Interp, used only if debug is turned on,
+ * for setting the "tk_dialog" variable. */
+ int lastCtrl; /* Used by hook proc to keep track of last
+ * control that had input focus, so when OK
+ * is pressed we know whether to browse a
+ * new directory or return. */
+ int lastIdx; /* Last item that was selected in directory
+ * browser listbox. */
+ TCHAR path[MAX_PATH]; /* On return from choose directory dialog,
+ * holds the selected path. Cannot return
+ * selected path in ofnPtr->lpstrFile because
+ * the default dialog proc stores a '\0' in
+ * it, since, of course, no _file_ was
+ * selected. */
+} ChooseDir;
/*
- * The following structure is used in the ChooseColor() call.
+ * Definitions of procedures used only in this file.
*/
-typedef struct _ChooseColorData {
- Tcl_Interp * interp;
- char * title; /* Title of the color dialog */
-} ChooseColorData;
-
-
-static int GetFileName _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv,
- int isOpen));
-static UINT CALLBACK ColorDlgHookProc _ANSI_ARGS_((HWND hDlg, UINT uMsg,
- WPARAM wParam, LPARAM lParam));
-static int MakeFilter _ANSI_ARGS_((Tcl_Interp *interp,
- OPENFILENAME *ofnPtr, char * string));
-static int ParseFileDlgArgs _ANSI_ARGS_((Tcl_Interp * interp,
- OPENFILENAME *ofnPtr, int argc, char ** argv,
- int isOpen));
-static int ProcessCDError _ANSI_ARGS_((Tcl_Interp * interp,
- DWORD dwErrorCode, HWND hWnd));
+
+static UINT APIENTRY ChooseDirectoryHookProc(HWND hdlg, UINT uMsg,
+ WPARAM wParam, LPARAM lParam);
+static UINT CALLBACK ColorDlgHookProc(HWND hDlg, UINT uMsg, WPARAM wParam,
+ LPARAM lParam);
+static int 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);
+static int TrySetDirectory(HWND hwnd, const TCHAR *dir);
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * EvalArgv --
+ * TkWinDialogDebug --
*
- * 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]
+ * 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:
- * TCL_ERROR if the command does not exist and cannot be autoloaded.
- * Otherwise, return the result of the evaluation of the command.
+ * None.
*
* Side effects:
- * The command may be autoloaded.
+ * This variable only makes sense if just one dialog is up at a time.
*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-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. */
+void
+TkWinDialogDebug(
+ int debug)
{
- 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;
- }
- }
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- return (*cmdInfo.proc)(cmdInfo.clientData, interp, argc, argv);
+ tsdPtr->debugFlag = debug;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * Tk_ChooseColorCmd --
+ * Tk_ChooseColorObjCmd --
*
* This procedure implements the color dialog box for the Windows
* platform. See the user documentation for details on what it
@@ -164,111 +171,120 @@ EvalArgv(interp, cmdName, argc, argv)
* 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)
+Tk_ChooseColorObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Tk_Window parent = Tk_MainWindow(interp);
- ChooseColorData custData;
- int oldMode;
+ Tk_Window tkwin, parent;
+ HWND hWnd;
+ int i, oldMode, winCode;
CHOOSECOLOR chooseColor;
- char * colorStr = NULL;
- int i;
- int winCode, tclCode;
- XColor * colorPtr = NULL;
static inited = 0;
- static long dwCustColors[16];
+ static COLORREF dwCustColors[16];
static long oldColor; /* the color selected last time */
-
- custData.title = NULL;
-
- if (!inited) {
+ static char *optionStrings[] = {
+ "-initialcolor", "-parent", "-title", NULL
+ };
+ enum options {
+ COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+ };
+
+ if (inited == 0) {
/*
* dwCustColors stores the custom color which the user can
- * modify. We store these colors in a fixed array so that the next
+ * 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)) ;
+ for (i = 0; i < 16; i++) {
+ dwCustColors[i] = RGB(255-i * 10, i, i * 10);
}
- oldColor = RGB(0xa0,0xa0,0xa0);
+ oldColor = RGB(0xa0, 0xa0, 0xa0);
inited = 1;
}
- /*
- * 1. Parse the arguments
- */
-
- chooseColor.lStructSize = sizeof(CHOOSECOLOR) ;
- chooseColor.hwndOwner = 0; /* filled in below */
- chooseColor.hInstance = 0;
- chooseColor.rgbResult = oldColor;
- chooseColor.lpCustColors = (LPDWORD) dwCustColors ;
- chooseColor.Flags = CC_RGBINIT | CC_FULLOPEN | CC_ENABLEHOOK;
- chooseColor.lCustData = (LPARAM)&custData;
- chooseColor.lpfnHook = ColorDlgHookProc;
- chooseColor.lpTemplateName = NULL;
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-initialcolor", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- colorStr = argv[v];
- }
- else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
- }
- }
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- custData.title = argv[v];
+ 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 = 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;
}
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -initialcolor, -parent or -title",
- NULL);
- return TCL_ERROR;
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
}
- }
- if (Tk_WindowId(parent) == None) {
- Tk_MakeWindowExist(parent);
- }
- chooseColor.hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case COLOR_INITIAL: {
+ XColor *colorPtr;
- if (colorStr != NULL) {
- colorPtr = Tk_GetColor(interp, Tk_MainWindow(interp), colorStr);
- if (!colorPtr) {
- return TCL_ERROR;
+ 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;
+ }
}
- chooseColor.rgbResult = RGB((colorPtr->red/0x100),
- (colorPtr->green/0x100), (colorPtr->blue/0x100));
- }
-
- /*
- * 2. Popup the dialog
- */
+ }
+ 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.
*/
@@ -278,6 +294,7 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv)
/*
* 3. Process the result of the dialog
*/
+
if (winCode) {
/*
* User has selected a color
@@ -285,75 +302,67 @@ Tk_ChooseColorCmd(clientData, interp, argc, argv)
char result[100];
sprintf(result, "#%02x%02x%02x",
- GetRValue(chooseColor.rgbResult),
- GetGValue(chooseColor.rgbResult),
- GetBValue(chooseColor.rgbResult));
+ GetRValue(chooseColor.rgbResult),
+ GetGValue(chooseColor.rgbResult),
+ GetBValue(chooseColor.rgbResult));
Tcl_AppendResult(interp, result, NULL);
- tclCode = TCL_OK;
-
oldColor = chooseColor.rgbResult;
- } else {
- /*
- * User probably pressed Cancel, or an error occurred
- */
- tclCode = ProcessCDError(interp, CommDlgExtendedError(),
- chooseColor.hwndOwner);
- }
-
- if (colorPtr) {
- Tk_FreeColor(colorPtr);
}
-
- return tclCode;
-
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
+ return TCL_OK;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
* ColorDlgHookProc --
*
- * Gets called during the execution of the color dialog. It processes
- * the "interesting" messages that Windows send to the dialog.
+ * Provides special handling of messages for the Color common dialog
+ * box. Used to set the title when the dialog first appears.
*
* Results:
- * TRUE if the message has been processed, FALSE otherwise.
+ * 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 when it is popped up.
+ * 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; /* word param, interpretation depends on uMsg*/
- LPARAM lParam; /* long param, interpretation depends on uMsg*/
+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. */
{
- CHOOSECOLOR * ccPtr;
- ChooseColorData * pCustData;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
switch (uMsg) {
- case WM_INITDIALOG:
- /* Save the pointer to CHOOSECOLOR so that we can use it later */
- SetWindowLong(hDlg, DWL_USER, lParam);
-
- /* Set the title string of the dialog */
- ccPtr = (CHOOSECOLOR*)lParam;
- pCustData = (ChooseColorData*)(ccPtr->lCustData);
- if (pCustData->title && *(pCustData->title)) {
- SetWindowText(hDlg, (LPCSTR)pCustData->title);
- }
+ case WM_INITDIALOG: {
+ const char *title;
+ CHOOSECOLOR *ccPtr;
+ Tcl_DString ds;
- return TRUE;
- }
+ /*
+ * Set the title string of the dialog.
+ */
+ ccPtr = (CHOOSECOLOR *) lParam;
+ title = (const char *) ccPtr->lCustData;
+ if ((title != NULL) && (title[0] != '\0')) {
+ Tcl_UtfToExternalDString(NULL, title, -1, &ds);
+ SetWindowText(hDlg, (TCHAR *) Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = (Tcl_Interp *) ccPtr->lpTemplateName;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hDlg);
+ }
+ return TRUE;
+ }
+ }
return FALSE;
}
@@ -371,21 +380,22 @@ CALLBACK ColorDlgHookProc(hDlg, uMsg, wParam, lParam)
*
* 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)
+Tk_GetOpenFileObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- return GetFileName(clientData, interp, argc, argv, OPEN_FILE);
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ return GetFileNameW(clientData, interp, objc, objv, 1);
+ } else {
+ return GetFileNameA(clientData, interp, objc, objv, 1);
+ }
}
/*
@@ -406,19 +416,23 @@ Tk_GetOpenFileCmd(clientData, interp, argc, argv)
*/
int
-Tk_GetSaveFileCmd(clientData, interp, argc, argv)
+Tk_GetSaveFileObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- return GetFileName(clientData, interp, argc, argv, SAVE_FILE);
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
+ return GetFileNameW(clientData, interp, objc, objv, 0);
+ } else {
+ return GetFileNameA(clientData, interp, objc, objv, 0);
+ }
}
/*
*----------------------------------------------------------------------
*
- * GetFileName --
+ * GetFileNameW --
*
* Calls GetOpenFileName() or GetSaveFileName().
*
@@ -432,41 +446,197 @@ Tk_GetSaveFileCmd(clientData, interp, argc, argv)
*/
static int
-GetFileName(clientData, interp, argc, argv, isOpen)
+GetFileNameW(clientData, interp, objc, objv, open)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
- int isOpen; /* true if we should call GetOpenFileName(),
- * false if we should call GetSaveFileName() */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+ int open; /* 1 to call GetOpenFileName(), 0 to
+ * call GetSaveFileName(). */
{
- OPENFILENAME openFileName, *ofnPtr;
- int tclCode, winCode, oldMode;
- OpenFileData *custData;
- char buffer[MAX_PATH+1];
-
- ofnPtr = &openFileName;
+ Tcl_Encoding unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");
+ OPENFILENAMEW ofn;
+ WCHAR file[MAX_PATH];
+ int result, winCode, oldMode, i;
+ 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 char *optionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-parent", "-title", NULL
+ };
+ enum options {
+ FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_PARENT, FILE_TITLE
+ };
+
+ result = TCL_ERROR;
+ file[0] = '\0';
/*
- * 1. Parse the arguments.
+ * Parse the arguments.
*/
- if (ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen) != TCL_OK) {
- return TCL_ERROR;
+
+ extension = NULL;
+ filter = NULL;
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&utfDirString);
+ tkwin = (Tk_Window) clientData;
+ title = NULL;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto end;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto end;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case FILE_DEFAULT: {
+ if (string[0] == '.') {
+ string++;
+ }
+ extension = string;
+ break;
+ }
+ case FILE_TYPES: {
+ Tcl_DStringFree(&utfFilterString);
+ if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ filter = Tcl_DStringValue(&utfFilterString);
+ break;
+ }
+ case FILE_INITDIR: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_INITFILE: {
+ Tcl_DString ds;
+
+ if (Tcl_TranslateFileName(interp, string, &ds) == NULL) {
+ goto end;
+ }
+ Tcl_UtfToExternal(NULL, unicodeEncoding, Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds), 0, NULL, (char *) file,
+ sizeof(file), NULL, NULL, NULL);
+ break;
+ }
+ case FILE_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ title = string;
+ break;
+ }
+ }
+ }
+
+ if (filter == NULL) {
+ if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = hWnd;
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = (WCHAR *) file;
+ ofn.nMaxFile = MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
+ | OFN_NOCHANGEDIR | OFN_EXPLORER;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lpfnHook = OFNHookProcW;
+ 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 (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);
+ ofn.lpstrInitialDir = (WCHAR *) Tcl_DStringValue(&dirString);
+ }
+
+ if (title != NULL) {
+ Tcl_UtfToExternalDString(unicodeEncoding, title, -1, &titleString);
+ ofn.lpstrTitle = (WCHAR *) Tcl_DStringValue(&titleString);
}
- custData = (OpenFileData*) ofnPtr->lCustData;
/*
- * 2. Call the common dialog function.
+ * Popup the dialog.
*/
+
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- GetCurrentDirectory(MAX_PATH+1, buffer);
- if (isOpen) {
- winCode = GetOpenFileName(ofnPtr);
+ if (open != 0) {
+ winCode = GetOpenFileNameW(&ofn);
} else {
- winCode = GetSaveFileName(ofnPtr);
+ winCode = GetSaveFileNameW(&ofn);
}
- SetCurrentDirectory(buffer);
- (void) Tcl_SetServiceMode(oldMode);
+ 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
@@ -475,256 +645,404 @@ GetFileName(clientData, interp, argc, argv, isOpen)
Tcl_ResetResult(interp);
- if (ofnPtr->lpstrInitialDir != NULL) {
- ckfree((char*) ofnPtr->lpstrInitialDir);
- }
-
/*
- * 3. Process the results.
+ * Process the results.
*/
- if (winCode) {
- if (ofnPtr->Flags & OFN_ALLOWMULTISELECT) {
- /* The result in custData->szFile contains many items,
- separated with null characters. It is terminated with
- two nulls in a row. The first element is the directory
- path. */
- char *dir;
- int dirlen;
- char *p;
- Tcl_DString fullname;
- Tcl_ResetResult(interp);
-
- /* Get directory */
- dir = custData->szFile;
- for (p = custData->szFile; p && *p; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
- }
- if (p[1] == '\0') {
- /* Only one file was returned. */
- Tcl_AppendElement(interp, dir);
- } else {
- while (*(++p)) {
- char *filname = p;
- for (; p && *p; p++) {
- if (*p == '\\') { *p = '/'; }
- }
- Tcl_DStringInit(&fullname);
- /* Add "dir/fname" to list */
- Tcl_DStringAppend(&fullname, dir, -1);
- Tcl_DStringAppend(&fullname, "/", -1);
- Tcl_DStringAppend(&fullname, filname, -1);
- /* Add to result string */
- Tcl_AppendElement(interp, Tcl_DStringValue(&fullname));
- /* Reset dynamic string */
- Tcl_DStringFree(&fullname);
- }
- }
- tclCode = TCL_OK;
- } else {
- /* Not a multiple-selection box; just treat it as a single
- element. */
- char *p;
- Tcl_ResetResult(interp);
-
- for (p = custData->szFile; p && *p; p++) {
- /*
- * Change the pathname to the Tcl "normalized" pathname, where
- * back slashes are used instead of forward slashes
- */
- if (*p == '\\') {
- *p = '/';
- }
+ if (winCode != 0) {
+ 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, custData->szFile, NULL);
- tclCode = TCL_OK;
}
- } else {
- tclCode = ProcessCDError(interp, CommDlgExtendedError(),
- ofnPtr->hwndOwner);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
}
- if (custData) {
- ckfree((char*)custData);
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
}
- if (ofnPtr->lpstrFilter) {
- ckfree((char*)ofnPtr->lpstrFilter);
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
}
+ Tcl_DStringFree(&filterString);
+ if (ofn.lpstrDefExt != NULL) {
+ Tcl_DStringFree(&extString);
+ }
+ result = TCL_OK;
+
+ end:
+ Tcl_DStringFree(&utfDirString);
+ Tcl_DStringFree(&utfFilterString);
- return tclCode;
+ return result;
}
/*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * ParseFileDlgArgs --
+ * OFNHookProcW --
*
- * Parses the arguments passed to tk_getOpenFile and tk_getSaveFile.
+ * Hook procedure called only if debugging is turned on. Sets
+ * the "tk_dialog" variable when the dialog is ready to receive
+ * messages.
*
* Results:
- * A standard TCL return value.
+ * Returns 0 to allow default processing of messages to occur.
*
* Side effects:
- * The OPENFILENAME structure is initialized and modified according
- * to the arguments.
+ * None.
*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-static int
-ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
- Tcl_Interp * interp; /* Current interpreter. */
- OPENFILENAME *ofnPtr; /* Info about the file dialog */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
- int isOpen; /* true if we should call GetOpenFileName(),
- * false if we should call GetSaveFileName() */
+static UINT APIENTRY
+OFNHookProcW(
+ HWND hdlg, // handle to child dialog window
+ UINT uMsg, // message identifier
+ WPARAM wParam, // message parameter
+ LPARAM lParam) // message parameter
{
- OpenFileData * custData;
- int i;
- Tk_Window parent = Tk_MainWindow(interp);
- int doneFilter = 0;
- int windowsMajorVersion;
- Tcl_DString buffer;
-
- custData = (OpenFileData*)ckalloc(sizeof(OpenFileData));
- custData->interp = interp;
- strcpy(custData->szFile, "");
-
- /* Fill in the OPENFILENAME structure to */
- ofnPtr->lStructSize = sizeof(OPENFILENAME);
- ofnPtr->hwndOwner = 0; /* filled in below */
- ofnPtr->lpstrFilter = NULL;
- ofnPtr->lpstrCustomFilter = NULL;
- ofnPtr->nMaxCustFilter = 0;
- ofnPtr->nFilterIndex = 0;
- ofnPtr->lpstrFile = custData->szFile;
- ofnPtr->nMaxFile = sizeof(custData->szFile);
- ofnPtr->lpstrFileTitle = NULL;
- ofnPtr->nMaxFileTitle = 0;
- ofnPtr->lpstrInitialDir = NULL;
- ofnPtr->lpstrTitle = NULL;
- ofnPtr->nFileOffset = 0;
- ofnPtr->nFileExtension = 0;
- ofnPtr->lpstrDefExt = NULL;
- ofnPtr->lpfnHook = NULL;
- ofnPtr->lCustData = (DWORD)custData;
- ofnPtr->lpTemplateName = NULL;
- ofnPtr->Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST;
-
- windowsMajorVersion = LOBYTE(LOWORD(GetVersion()));
- if (windowsMajorVersion >= 4) {
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ OPENFILENAMEW *ofnPtr;
+
+ if (uMsg == WM_INITDIALOG) {
+ SetWindowLong(hdlg, GWL_USERDATA, lParam);
+ } else if (uMsg == WM_WINDOWPOSCHANGED) {
/*
- * Use the "explorer" style file selection box on platforms that
- * support it (Win95 and NT4.0, both have a major version number
- * of 4)
+ * 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.
*/
- ofnPtr->Flags |= OFN_EXPLORER;
+
+ ofnPtr = (OPENFILENAMEW *) GetWindowLong(hdlg, GWL_USERDATA);
+ if (ofnPtr != NULL) {
+ hdlg = GetParent(hdlg);
+ tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
+ SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
+ }
}
+ 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[MAX_PATH], savePath[MAX_PATH];
+ int result, winCode, oldMode, i;
+ 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 char *optionStrings[] = {
+ "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+ "-parent", "-title", NULL
+ };
+ enum options {
+ FILE_DEFAULT, FILE_TYPES, FILE_INITDIR, FILE_INITFILE,
+ FILE_PARENT, FILE_TITLE
+ };
+
+ result = TCL_ERROR;
+ file[0] = '\0';
- if (isOpen) {
- ofnPtr->Flags |= OFN_FILEMUSTEXIST;
- } else {
- ofnPtr->Flags |= OFN_OVERWRITEPROMPT;
- }
+ /*
+ * Parse the arguments.
+ */
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
+ extension = NULL;
+ filter = NULL;
+ Tcl_DStringInit(&utfFilterString);
+ Tcl_DStringInit(&utfDirString);
+ tkwin = (Tk_Window) clientData;
+ title = NULL;
- if (strncmp(argv[i], "-defaultextension", len)==0) {
- if (v==argc) {goto arg_missing;}
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
- ofnPtr->lpstrDefExt = argv[v];
- if (ofnPtr->lpstrDefExt[0] == '.') {
- /* Windows will insert the dot for us */
- ofnPtr->lpstrDefExt ++;
- }
- }
- else if (strncmp(argv[i], "-filetypes", len)==0) {
- if (v==argc) {goto arg_missing;}
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
- if (MakeFilter(interp, ofnPtr, argv[v]) != TCL_OK) {
- return TCL_ERROR;
- }
- doneFilter = 1;
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto end;
}
- else if (strncmp(argv[i], "-initialdir", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
- return TCL_ERROR;
- }
- ofnPtr->lpstrInitialDir = ckalloc(Tcl_DStringLength(&buffer)+1);
- strcpy((char*)ofnPtr->lpstrInitialDir, Tcl_DStringValue(&buffer));
- Tcl_DStringFree(&buffer);
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto end;
}
- else if (strncmp(argv[i], "-initialfile", len)==0) {
- if (v==argc) {goto arg_missing;}
- if (Tcl_TranslateFileName(interp, argv[v], &buffer) == NULL) {
- return TCL_ERROR;
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case FILE_DEFAULT: {
+ if (string[0] == '.') {
+ string++;
+ }
+ extension = string;
+ break;
}
- strcpy(ofnPtr->lpstrFile, Tcl_DStringValue(&buffer));
- Tcl_DStringFree(&buffer);
- }
- else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
+ case FILE_TYPES: {
+ Tcl_DStringFree(&utfFilterString);
+ if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) {
+ goto end;
+ }
+ filter = Tcl_DStringValue(&utfFilterString);
+ break;
}
- }
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- ofnPtr->lpstrTitle = argv[v];
- }
- else if (strncmp(argv[i], "-multiple", len)==0) {
- int tmp;
- if (v==argc) {goto arg_missing;}
+ case FILE_INITDIR: {
+ Tcl_DStringFree(&utfDirString);
+ if (Tcl_TranslateFileName(interp, string,
+ &utfDirString) == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_INITFILE: {
+ Tcl_DString ds;
- if (Tcl_GetBoolean(interp, argv[i+1], &tmp) != TCL_OK) {
- return TCL_ERROR;
+ 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;
}
- if (tmp) {
- ofnPtr->Flags |= OFN_ALLOWMULTISELECT;
+ case FILE_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ break;
+ }
+ case FILE_TITLE: {
+ title = string;
+ break;
}
}
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -defaultextension, ",
- "-filetypes, -initialdir, -initialfile, -parent or -title",
- NULL);
- return TCL_ERROR;
+ }
+
+ if (filter == NULL) {
+ if (MakeFilter(interp, "", &utfFilterString) != TCL_OK) {
+ goto end;
}
}
- if (!doneFilter) {
- if (MakeFilter(interp, ofnPtr, "") != TCL_OK) {
- return TCL_ERROR;
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = hWnd;
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = (LPTSTR) file;
+ ofn.nMaxFile = MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY | OFN_PATHMUSTEXIST
+ | OFN_NOCHANGEDIR | OFN_EXPLORER;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lpfnHook = 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 (extension != NULL) {
+ Tcl_UtfToExternalDString(NULL, extension, -1, &extString);
+ ofn.lpstrDefExt = (LPTSTR) Tcl_DStringValue(&extString);
+ }
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfFilterString),
+ Tcl_DStringLength(&utfFilterString), &filterString);
+ ofn.lpstrFilter = (LPTSTR) Tcl_DStringValue(&filterString);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
+ }
+ if (title != NULL) {
+ Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
+ ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ }
+
+ /*
+ * Popup the dialog.
+ */
+
+ GetCurrentDirectory(MAX_PATH, savePath);
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (open != 0) {
+ winCode = GetOpenFileName(&ofn);
+ } else {
+ winCode = GetSaveFileName(&ofn);
+ }
+ Tcl_SetServiceMode(oldMode);
+ SetCurrentDirectory(savePath);
+
+ /*
+ * 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) {
+ char *p;
+ Tcl_DString ds;
+
+ Tcl_ExternalToUtfDString(NULL, (char *) ofn.lpstrFile, -1, &ds);
+ for (p = Tcl_DStringValue(&ds); *p != '\0'; p++) {
+ /*
+ * Change the pathname to the Tcl "normalized" pathname, where
+ * back slashes are used instead of forward slashes
+ */
+ if (*p == '\\') {
+ *p = '/';
+ }
}
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
}
- if (Tk_WindowId(parent) == None) {
- Tk_MakeWindowExist(parent);
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
}
- ofnPtr->hwndOwner = Tk_GetHWND(Tk_WindowId(parent));
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
+ }
+ Tcl_DStringFree(&filterString);
+ if (ofn.lpstrDefExt != NULL) {
+ Tcl_DStringFree(&extString);
+ }
+ result = TCL_OK;
- return TCL_OK;
+ end:
+ Tcl_DStringFree(&utfDirString);
+ Tcl_DStringFree(&utfFilterString);
+
+ return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * OFNHookProc --
+ *
+ * Hook procedure called only if debugging is turned on. Sets
+ * the "tk_dialog" variable when the dialog is ready to receive
+ * messages.
+ *
+ * Results:
+ * Returns 0 to allow default processing of messages to occur.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
+static UINT APIENTRY
+OFNHookProc(
+ HWND hdlg, // handle to child dialog window
+ UINT uMsg, // message identifier
+ WPARAM wParam, // message parameter
+ LPARAM lParam) // message parameter
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ OPENFILENAME *ofnPtr;
+
+ if (uMsg == WM_INITDIALOG) {
+ SetWindowLong(hdlg, GWL_USERDATA, lParam);
+ } else if (uMsg == WM_WINDOWPOSCHANGED) {
+ /*
+ * This message is delivered at the right time to both
+ * old-style and explorer-style hook procs to enable Tk
+ * to set the debug information. Unhooks itself so it
+ * won't set the debug information every time it gets a
+ * WM_WINDOWPOSCHANGED message.
+ */
+
+ ofnPtr = (OPENFILENAME *) GetWindowLong(hdlg, GWL_USERDATA);
+ if (ofnPtr != NULL) {
+ if (ofnPtr->Flags & OFN_EXPLORER) {
+ hdlg = GetParent(hdlg);
+ }
+ tsdPtr->debugInterp = (Tcl_Interp *) ofnPtr->lCustData;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hdlg);
+ SetWindowLong(hdlg, GWL_USERDATA, (LPARAM) NULL);
+ }
+ }
+ return 0;
}
/*
@@ -743,10 +1061,11 @@ ParseFileDlgArgs(interp, ofnPtr, argc, argv, isOpen)
*
*----------------------------------------------------------------------
*/
-static int MakeFilter(interp, ofnPtr, string)
+static int
+MakeFilter(interp, string, dsPtr)
Tcl_Interp *interp; /* Current interpreter. */
- OPENFILENAME *ofnPtr; /* Info about the file dialog */
char *string; /* String value of the -filetypes option */
+ Tcl_DString *dsPtr; /* Filled with windows filter string. */
{
char *filterStr;
char *p;
@@ -761,7 +1080,7 @@ static int MakeFilter(interp, ofnPtr, string)
if (flist.filters == NULL) {
/*
- * Use "All Files (*.*) as the default filter is none is specified
+ * Use "All Files (*.*) as the default filter if none is specified
*/
char *defaultFilter = "All Files (*.*)";
@@ -849,10 +1168,8 @@ static int MakeFilter(interp, ofnPtr, string)
*p = '\0';
}
- if (ofnPtr->lpstrFilter != NULL) {
- ckfree((char*)ofnPtr->lpstrFilter);
- }
- ofnPtr->lpstrFilter = filterStr;
+ Tcl_DStringAppend(dsPtr, filterStr, p - filterStr);
+ ckfree((char *) filterStr);
TkFreeFileFilters(&flist);
return TCL_OK;
@@ -861,276 +1178,594 @@ static int MakeFilter(interp, ofnPtr, string)
/*
*----------------------------------------------------------------------
*
- * Tk_MessageBoxCmd --
+ * Tk_ChooseDirectoryObjCmd --
*
- * This procedure implements the MessageBox window for the
- * Windows platform. See the user documentation for details on what
- * it does.
+ * 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:
- * None. The MessageBox window will be destroy before this procedure
- * returns.
+ * A modal dialog window is created. Tcl_SetServiceMode() is
+ * called to allow background events to be processed
*
*----------------------------------------------------------------------
*/
int
-Tk_MessageBoxCmd(clientData, interp, argc, argv)
+Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
ClientData clientData; /* Main window associated with interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int flags;
- Tk_Window parent = NULL;
+ OPENFILENAME ofn;
+ TCHAR path[MAX_PATH], savePath[MAX_PATH];
+ ChooseDir cd;
+ int result, mustExist, code, mode, i;
+ Tk_Window tkwin;
HWND hWnd;
- char *message = "";
- char *title = "";
- int icon = MB_ICONINFORMATION;
- int type = MB_OK;
- int modal = MB_SYSTEMMODAL;
- int i, j;
- char *result;
- int code, oldMode;
- char *defaultBtn = NULL;
- int defaultBtnIdx = -1;
-
- for (i=1; i<argc; i+=2) {
- int v = i+1;
- int len = strlen(argv[i]);
-
- if (strncmp(argv[i], "-default", len)==0) {
- if (v==argc) {goto arg_missing;}
-
- defaultBtn = argv[v];
+ char *utfTitle;
+ Tcl_DString utfDirString;
+ Tcl_DString titleString, dirString;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ static char *optionStrings[] = {
+ "-initialdir", "-mustexist", "-parent", "-title",
+ NULL
+ };
+ enum options {
+ DIR_INITIAL, DIR_EXIST, DIR_PARENT, FILE_TITLE
+ };
+
+ if (tsdPtr->WM_LBSELCHANGED == 0) {
+ tsdPtr->WM_LBSELCHANGED = RegisterWindowMessage(LBSELCHSTRING);
+ }
+
+ result = TCL_ERROR;
+ path[0] = '\0';
+
+ Tcl_DStringInit(&utfDirString);
+ mustExist = 0;
+ tkwin = (Tk_Window) clientData;
+ utfTitle = NULL;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ 0, &index) != TCL_OK) {
+ goto cleanup;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ goto cleanup;
}
- else if (strncmp(argv[i], "-icon", len)==0) {
- if (v==argc) {goto arg_missing;}
- if (strcmp(argv[v], "error") == 0) {
- icon = MB_ICONERROR;
+ 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;
}
- else if (strcmp(argv[v], "info") == 0) {
- icon = MB_ICONINFORMATION;
+ case DIR_EXIST: {
+ if (Tcl_GetBooleanFromObj(interp, valuePtr, &mustExist) != TCL_OK) {
+ goto cleanup;
+ }
+ break;
}
- else if (strcmp(argv[v], "question") == 0) {
- icon = MB_ICONQUESTION;
+ case DIR_PARENT: {
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ goto cleanup;
+ }
+ break;
}
- else if (strcmp(argv[v], "warning") == 0) {
- icon = MB_ICONWARNING;
+ case FILE_TITLE: {
+ utfTitle = string;
+ break;
}
- else {
- Tcl_AppendResult(interp, "invalid icon \"", argv[v],
- "\", must be error, info, question or warning", NULL);
- return TCL_ERROR;
+ }
+ }
+
+ Tk_MakeWindowExist(tkwin);
+ hWnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ cd.interp = interp;
+
+ ofn.lStructSize = sizeof(ofn);
+ ofn.hwndOwner = hWnd;
+ ofn.hInstance = (HINSTANCE) GetWindowLong(ofn.hwndOwner,
+ GWL_HINSTANCE);
+ ofn.lpstrFilter = NULL;
+ ofn.lpstrCustomFilter = NULL;
+ ofn.nMaxCustFilter = 0;
+ ofn.nFilterIndex = 0;
+ ofn.lpstrFile = NULL; //(TCHAR *) path;
+ ofn.nMaxFile = MAX_PATH;
+ ofn.lpstrFileTitle = NULL;
+ ofn.nMaxFileTitle = 0;
+ ofn.lpstrInitialDir = NULL;
+ ofn.lpstrTitle = NULL;
+ ofn.Flags = OFN_HIDEREADONLY
+ | OFN_ENABLEHOOK | OFN_ENABLETEMPLATE;
+ ofn.nFileOffset = 0;
+ ofn.nFileExtension = 0;
+ ofn.lpstrDefExt = NULL;
+ ofn.lCustData = (LPARAM) &cd;
+ ofn.lpfnHook = ChooseDirectoryHookProc;
+ ofn.lpTemplateName = MAKEINTRESOURCE(FILEOPENORD);
+
+ if (Tcl_DStringValue(&utfDirString)[0] != '\0') {
+ Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&utfDirString),
+ Tcl_DStringLength(&utfDirString), &dirString);
+ ofn.lpstrInitialDir = (LPTSTR) Tcl_DStringValue(&dirString);
+ }
+ if (mustExist) {
+ ofn.Flags |= OFN_PATHMUSTEXIST;
+ }
+ if (utfTitle != NULL) {
+ Tcl_UtfToExternalDString(NULL, utfTitle, -1, &titleString);
+ ofn.lpstrTitle = (LPTSTR) Tcl_DStringValue(&titleString);
+ }
+
+ /*
+ * Display dialog. The choose directory dialog doesn't preserve the
+ * current directory, so it must be saved and restored here.
+ */
+
+ GetCurrentDirectory(MAX_PATH, savePath);
+ mode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ code = GetOpenFileName(&ofn);
+ Tcl_SetServiceMode(mode);
+ SetCurrentDirectory(savePath);
+
+ /*
+ * 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 = '/';
}
}
- else if (strncmp(argv[i], "-message", len)==0) {
- if (v==argc) {goto arg_missing;}
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ }
+
+ if (ofn.lpstrTitle != NULL) {
+ Tcl_DStringFree(&titleString);
+ }
+ if (ofn.lpstrInitialDir != NULL) {
+ Tcl_DStringFree(&dirString);
+ }
+ result = TCL_OK;
+
+ cleanup:
+ Tcl_DStringFree(&utfDirString);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChooseDirectoryHookProc --
+ *
+ * Hook procedure called by the ChooseDirectory dialog to modify
+ * its default behavior. The ChooseDirectory dialog is really an
+ * OpenFile dialog with certain controls rearranged and certain
+ * behaviors changed. For instance, typing a name in the
+ * ChooseDirectory dialog selects a directory, rather than
+ * selecting a file.
+ *
+ * Results:
+ * Returns 0 to allow default processing of message, or 1 to
+ * tell default dialog procedure not to process the message.
+ *
+ * Side effects:
+ * A dialog window is created the first this procedure is called.
+ * This window is not destroyed and will be reused the next time
+ * the application invokes the "tk_getOpenFile" or
+ * "tk_getSaveFile" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static UINT APIENTRY
+ChooseDirectoryHookProc(
+ HWND hwnd,
+ UINT message,
+ WPARAM wParam,
+ LPARAM lParam)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ OPENFILENAME *ofnPtr;
+
+ /*
+ * GWL_USERDATA keeps track of ofnPtr.
+ */
+
+ ofnPtr = (OPENFILENAME *) GetWindowLong(hwnd, GWL_USERDATA);
+
+ if (message == WM_INITDIALOG) {
+ ChooseDir *cdPtr;
- message = argv[v];
+ SetWindowLong(hwnd, GWL_USERDATA, lParam);
+ ofnPtr = (OPENFILENAME *) lParam;
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
+ cdPtr->lastCtrl = 0;
+ cdPtr->lastIdx = 1000;
+ cdPtr->path[0] = '\0';
+
+ if (ofnPtr->lpstrInitialDir == NULL) {
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ } else {
+ lstrcpy(cdPtr->path, ofnPtr->lpstrInitialDir);
}
- else if (strncmp(argv[i], "-parent", len)==0) {
- if (v==argc) {goto arg_missing;}
+ SetDlgItemText(hwnd, edt10, cdPtr->path);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ if (tsdPtr->debugFlag) {
+ tsdPtr->debugInterp = cdPtr->interp;
+ Tcl_DoWhenIdle(SetTkDialog, (ClientData) hwnd);
+ }
+ return 0;
+ }
+ if (ofnPtr == NULL) {
+ return 0;
+ }
- parent=Tk_NameToWindow(interp, argv[v], Tk_MainWindow(interp));
- if (parent == NULL) {
- return TCL_ERROR;
+ if (message == tsdPtr->WM_LBSELCHANGED) {
+ /*
+ * Called when double-clicking on directory.
+ * If directory wasn't already open, browse that directory.
+ * If directory was already open, return selected directory.
+ */
+
+ ChooseDir *cdPtr;
+ int idCtrl, thisItem;
+
+ idCtrl = (int) wParam;
+ thisItem = LOWORD(lParam);
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
+
+ GetCurrentDirectory(MAX_PATH, cdPtr->path);
+ if (idCtrl == lst2) {
+ if (cdPtr->lastIdx == thisItem) {
+ EndDialog(hwnd, IDOK);
+ return 1;
}
+ cdPtr->lastIdx = thisItem;
}
- else if (strncmp(argv[i], "-title", len)==0) {
- if (v==argc) {goto arg_missing;}
+ SetDlgItemText(hwnd, edt10, cdPtr->path);
+ SendDlgItemMessage(hwnd, edt10, EM_SETSEL, 0, -1);
+ } else if (message == WM_COMMAND) {
+ ChooseDir *cdPtr;
+ int idCtrl, notifyCode;
+
+ idCtrl = LOWORD(wParam);
+ notifyCode = HIWORD(wParam);
+ cdPtr = (ChooseDir *) ofnPtr->lCustData;
+
+ if ((idCtrl != IDOK) || (notifyCode != BN_CLICKED)) {
+ /*
+ * OK Button wasn't clicked. Do the default.
+ */
- title = argv[v];
+ if ((idCtrl == lst2) || (idCtrl == edt10)) {
+ cdPtr->lastCtrl = idCtrl;
+ }
+ return 0;
}
- else if (strncmp(argv[i], "-type", len)==0) {
- int found = 0;
- if (v==argc) {goto arg_missing;}
+ /*
+ * 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];
- for (j=0; j<NUM_TYPES; j++) {
- if (strcmp(argv[v], msgTypeInfo[j].name) == 0) {
- type = msgTypeInfo[j].type;
- found = 1;
- break;
+ 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 (!found) {
- Tcl_AppendResult(interp, "invalid message box type \"",
- argv[v], "\", must be abortretryignore, ok, ",
- "okcancel, retrycancel, yesno or yesnocancel", NULL);
- return TCL_ERROR;
+ 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;
}
- }
- else if (strncmp (argv[i], "-modal", len) == 0) {
- if (v==argc) {goto arg_missing;}
+
+ 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.
+ */
- if (strcmp(argv[v], "system") == 0) {
- modal = MB_SYSTEMMODAL;
+ 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 (strcmp(argv[v], "task") == 0) {
- modal = MB_TASKMODAL;
+ } 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxObjCmd --
+ *
+ * This procedure implements the MessageBox window for the
+ * Windows platform. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * See user documentation.
+ *
+ * Side effects:
+ * None. The MessageBox window will be destroy before this procedure
+ * returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_MessageBoxObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ Tk_Window tkwin, parent;
+ HWND hWnd;
+ char *message, *title;
+ int defaultBtn, icon, type;
+ int i, oldMode, flags, winCode;
+ Tcl_DString messageString, titleString;
+ static char *optionStrings[] = {
+ "-default", "-icon", "-message", "-parent",
+ "-title", "-type", NULL
+ };
+ enum options {
+ MSG_DEFAULT, MSG_ICON, MSG_MESSAGE, MSG_PARENT,
+ MSG_TITLE, MSG_TYPE
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ defaultBtn = -1;
+ icon = MB_ICONINFORMATION;
+ message = NULL;
+ parent = tkwin;
+ title = NULL;
+ type = MB_OK;
+
+ for (i = 1; i < objc; i += 2) {
+ int index;
+ char *string;
+ Tcl_Obj *optionPtr, *valuePtr;
+
+ optionPtr = objv[i];
+ valuePtr = objv[i + 1];
+
+ if (Tcl_GetIndexFromObj(interp, optionPtr, optionStrings, "option",
+ TCL_EXACT, &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (i + 1 == objc) {
+ string = Tcl_GetStringFromObj(optionPtr, NULL);
+ Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(valuePtr, NULL);
+ switch ((enum options) index) {
+ case MSG_DEFAULT:
+ defaultBtn = TkFindStateNumObj(interp, optionPtr, buttonMap,
+ valuePtr);
+ if (defaultBtn < 0) {
+ return TCL_ERROR;
}
- else if (strcmp(argv[v], "owner") == 0) {
- modal = MB_APPLMODAL;
+ break;
+
+ case MSG_ICON:
+ icon = TkFindStateNumObj(interp, optionPtr, iconMap, valuePtr);
+ if (icon < 0) {
+ return TCL_ERROR;
}
- else {
- Tcl_AppendResult(interp, "invalid modality \"", argv[v],
- "\", must be system, task or owner", NULL);
+ break;
+
+ case MSG_MESSAGE:
+ message = string;
+ break;
+
+ case MSG_PARENT:
+ parent = Tk_NameToWindow(interp, string, tkwin);
+ if (parent == NULL) {
return TCL_ERROR;
}
- }
- else {
- Tcl_AppendResult(interp, "unknown option \"",
- argv[i], "\", must be -default, -icon, ",
- "-message, -parent, -title or -type", NULL);
+ break;
+
+ case MSG_TITLE:
+ title = string;
+ break;
+
+ case MSG_TYPE:
+ type = TkFindStateNumObj(interp, optionPtr, typeMap, valuePtr);
+ if (type < 0) {
return TCL_ERROR;
- }
- }
+ }
+ break;
- /* Make sure we have a valid hWnd to act as the parent of this message box
- */
- if (parent == NULL && modal == MB_TASKMODAL) {
- hWnd = NULL;
- }
- else {
- if (parent == NULL) {
- parent = Tk_MainWindow(interp);
}
- if (Tk_WindowId(parent) == None) {
- Tk_MakeWindowExist(parent);
- }
- hWnd = Tk_GetHWND(Tk_WindowId(parent));
}
- if (defaultBtn != NULL) {
- for (i=0; i<NUM_TYPES; i++) {
- if (type == msgTypeInfo[i].type) {
- for (j=0; j<msgTypeInfo[i].numButtons; j++) {
- if (strcmp(defaultBtn, msgTypeInfo[i].btnNames[j])==0) {
- defaultBtnIdx = j;
+ 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 \"",
- defaultBtn, "\"", NULL);
+ TkFindStateString(buttonMap, defaultBtn),
+ "\"", NULL);
return TCL_ERROR;
}
break;
}
}
-
- switch (defaultBtnIdx) {
- case 0: flags = MB_DEFBUTTON1; break;
- case 1: flags = MB_DEFBUTTON2; break;
- case 2: flags = MB_DEFBUTTON3; break;
- case 3: flags = MB_DEFBUTTON4; break;
- }
- } else {
- flags = 0;
+ flags = buttonFlagMap[defaultBtnIdx];
}
-
- flags |= icon | type;
+
+ flags |= icon | type | MB_SYSTEMMODAL;
+
+ Tcl_UtfToExternalDString(NULL, message, -1, &messageString);
+ Tcl_UtfToExternalDString(NULL, title, -1, &titleString);
+
oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- code = MessageBox(hWnd, message, title, flags|modal);
+ winCode = MessageBox(hWnd, Tcl_DStringValue(&messageString),
+ Tcl_DStringValue(&titleString), flags);
(void) Tcl_SetServiceMode(oldMode);
- switch (code) {
- case IDABORT: result = "abort"; break;
- case IDCANCEL: result = "cancel"; break;
- case IDIGNORE: result = "ignore"; break;
- case IDNO: result = "no"; break;
- case IDOK: result = "ok"; break;
- case IDRETRY: result = "retry"; break;
- case IDYES: result = "yes"; break;
- default: result = "";
- }
-
/*
- * When we come to here interp->result may have been changed by some
- * background scripts. Call Tcl_SetResult() to make sure that any stuff
- * lingering in interp->result will not appear in the result of
- * this command.
+ * 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_SetResult(interp, result, TCL_STATIC);
- return TCL_OK;
+ Tcl_DStringFree(&messageString);
+ Tcl_DStringFree(&titleString);
- arg_missing:
- Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
- NULL);
- return TCL_ERROR;
+ Tcl_SetResult(interp, TkFindStateString(buttonMap, winCode), TCL_STATIC);
+ return TCL_OK;
}
-
-/*
- *----------------------------------------------------------------------
- *
- * ProcessCDError --
- *
- * This procedure gets called if a Windows-specific error message
- * has occurred during the execution of a common dialog or the
- * user has pressed the CANCEL button.
- *
- * Results:
- * If an error has indeed happened, returns a standard TCL result
- * that reports the error code in string format. If the user has
- * pressed the CANCEL button (dwErrorCode == 0), resets
- * interp->result to the empty string.
- *
- * Side effects:
- * interp->result is changed.
- *
- *----------------------------------------------------------------------
- */
-static int ProcessCDError(interp, dwErrorCode, hWnd)
- Tcl_Interp * interp; /* Current interpreter. */
- DWORD dwErrorCode; /* The Windows-specific error code */
- HWND hWnd; /* window in which the error happened*/
-{
- char *string;
- Tcl_ResetResult(interp);
+static void
+SetTkDialog(ClientData clientData)
+{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ char buf[32];
+ HWND hwnd;
- switch(dwErrorCode) {
- case 0: /* User has hit CANCEL */
- return TCL_OK;
-
- case CDERR_DIALOGFAILURE: string="CDERR_DIALOGFAILURE"; break;
- case CDERR_STRUCTSIZE: string="CDERR_STRUCTSIZE"; break;
- case CDERR_INITIALIZATION: string="CDERR_INITIALIZATION"; break;
- case CDERR_NOTEMPLATE: string="CDERR_NOTEMPLATE"; break;
- case CDERR_NOHINSTANCE: string="CDERR_NOHINSTANCE"; break;
- case CDERR_LOADSTRFAILURE: string="CDERR_LOADSTRFAILURE"; break;
- case CDERR_FINDRESFAILURE: string="CDERR_FINDRESFAILURE"; break;
- case CDERR_LOADRESFAILURE: string="CDERR_LOADRESFAILURE"; break;
- case CDERR_LOCKRESFAILURE: string="CDERR_LOCKRESFAILURE"; break;
- case CDERR_MEMALLOCFAILURE: string="CDERR_MEMALLOCFAILURE"; break;
- case CDERR_MEMLOCKFAILURE: string="CDERR_MEMLOCKFAILURE"; break;
- case CDERR_NOHOOK: string="CDERR_NOHOOK"; break;
- case PDERR_SETUPFAILURE: string="PDERR_SETUPFAILURE"; break;
- case PDERR_PARSEFAILURE: string="PDERR_PARSEFAILURE"; break;
- case PDERR_RETDEFFAILURE: string="PDERR_RETDEFFAILURE"; break;
- case PDERR_LOADDRVFAILURE: string="PDERR_LOADDRVFAILURE"; break;
- case PDERR_GETDEVMODEFAIL: string="PDERR_GETDEVMODEFAIL"; break;
- case PDERR_INITFAILURE: string="PDERR_INITFAILURE"; break;
- case PDERR_NODEVICES: string="PDERR_NODEVICES"; break;
- case PDERR_NODEFAULTPRN: string="PDERR_NODEFAULTPRN"; break;
- case PDERR_DNDMMISMATCH: string="PDERR_DNDMMISMATCH"; break;
- case PDERR_CREATEICFAILURE: string="PDERR_CREATEICFAILURE"; break;
- case PDERR_PRINTERNOTFOUND: string="PDERR_PRINTERNOTFOUND"; break;
- case CFERR_NOFONTS: string="CFERR_NOFONTS"; break;
- case FNERR_SUBCLASSFAILURE: string="FNERR_SUBCLASSFAILURE"; break;
- case FNERR_INVALIDFILENAME: string="FNERR_INVALIDFILENAME"; break;
- case FNERR_BUFFERTOOSMALL: string="FNERR_BUFFERTOOSMALL"; break;
-
- default:
- string="unknown error";
- }
+ hwnd = (HWND) clientData;
- Tcl_AppendResult(interp, "Win32 internal error: ", string, NULL);
- return TCL_ERROR;
+ sprintf(buf, "0x%08x", hwnd);
+ Tcl_SetVar(tsdPtr->debugInterp, "tk_dialog", buf, TCL_GLOBAL_ONLY);
}
diff --git a/tk/win/tkWinDraw.c b/tk/win/tkWinDraw.c
index 445166705d8..eafe1effd78 100644
--- a/tk/win/tkWinDraw.c
+++ b/tk/win/tkWinDraw.c
@@ -106,6 +106,12 @@ static int bltModes[] = {
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:
*/
@@ -119,6 +125,7 @@ static void DrawOrFillArc _ANSI_ARGS_((Display *display,
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));
/*
*----------------------------------------------------------------------
@@ -166,6 +173,7 @@ TkWinGetDrawableDC(display, d, state)
cmap = twdPtr->bitmap.colormap;
}
state->palette = TkWinSelectPalette(dc, cmap);
+ state->bkmode = GetBkMode(dc);
return dc;
}
@@ -192,6 +200,7 @@ TkWinReleaseDrawableDC(d, dc, state)
TkWinDCState *state;
{
TkWinDrawable *twdPtr = (TkWinDrawable *)d;
+ SetBkMode(dc, state->bkmode);
SelectPalette(dc, state->palette, TRUE);
RealizePalette(dc);
if (twdPtr->type == TWD_WINDOW) {
@@ -212,7 +221,8 @@ TkWinReleaseDrawableDC(d, dc, state)
* Returns the converted array of POINTs.
*
* Side effects:
- * Allocates a block of memory that should not be freed.
+ * Allocates a block of memory in thread local storage that
+ * should not be freed.
*
*----------------------------------------------------------------------
*/
@@ -224,8 +234,8 @@ ConvertPoints(points, npoints, mode, bbox)
int mode; /* CoordModeOrigin or CoordModePrevious. */
RECT *bbox; /* Bounding box of points. */
{
- static POINT *winPoints = NULL; /* Array of points that is reused. */
- static int nWinPoints = -1; /* Current size of point array. */
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
int i;
/*
@@ -233,16 +243,16 @@ ConvertPoints(points, npoints, mode, bbox)
* we reuse the last array if it is large enough.
*/
- if (npoints > nWinPoints) {
- if (winPoints != NULL) {
- ckfree((char *) winPoints);
+ if (npoints > tsdPtr->nWinPoints) {
+ if (tsdPtr->winPoints != NULL) {
+ ckfree((char *) tsdPtr->winPoints);
}
- winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints);
- if (winPoints == NULL) {
- nWinPoints = -1;
+ tsdPtr->winPoints = (POINT *) ckalloc(sizeof(POINT) * npoints);
+ if (tsdPtr->winPoints == NULL) {
+ tsdPtr->nWinPoints = -1;
return NULL;
}
- nWinPoints = npoints;
+ tsdPtr->nWinPoints = npoints;
}
bbox->left = bbox->right = points[0].x;
@@ -250,26 +260,26 @@ ConvertPoints(points, npoints, mode, bbox)
if (mode == CoordModeOrigin) {
for (i = 0; i < npoints; i++) {
- winPoints[i].x = points[i].x;
- winPoints[i].y = points[i].y;
- bbox->left = MIN(bbox->left, winPoints[i].x);
- bbox->right = MAX(bbox->right, winPoints[i].x);
- bbox->top = MIN(bbox->top, winPoints[i].y);
- bbox->bottom = MAX(bbox->bottom, winPoints[i].y);
+ 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 {
- winPoints[0].x = points[0].x;
- winPoints[0].y = points[0].y;
+ tsdPtr->winPoints[0].x = points[0].x;
+ tsdPtr->winPoints[0].y = points[0].y;
for (i = 1; i < npoints; i++) {
- winPoints[i].x = winPoints[i-1].x + points[i].x;
- winPoints[i].y = winPoints[i-1].y + points[i].y;
- bbox->left = MIN(bbox->left, winPoints[i].x);
- bbox->right = MAX(bbox->right, winPoints[i].x);
- bbox->top = MIN(bbox->top, winPoints[i].y);
- bbox->bottom = MAX(bbox->bottom, winPoints[i].y);
+ 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 winPoints;
+ return tsdPtr->winPoints;
}
/*
@@ -555,33 +565,7 @@ TkPutImage(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x,
infoPtr->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
infoPtr->bmiHeader.biWidth = image->width;
-
- /*
- * The following code works around a bug in Win32s. CreateDIBitmap
- * fails under Win32s for top-down images. So we have to reverse the
- * order of the scanlines. If we are not running under Win32s, we can
- * just declare the image to be top-down.
- */
-
- if (tkpIsWin32s) {
- int y;
- char *srcPtr, *dstPtr, *temp;
-
- temp = ckalloc((unsigned) image->bytes_per_line);
- srcPtr = image->data;
- dstPtr = image->data+(image->bytes_per_line * (image->height - 1));
- for (y = 0; y < (image->height/2); y++) {
- memcpy(temp, srcPtr, image->bytes_per_line);
- memcpy(srcPtr, dstPtr, image->bytes_per_line);
- memcpy(dstPtr, temp, image->bytes_per_line);
- srcPtr += image->bytes_per_line;
- dstPtr -= image->bytes_per_line;
- }
- ckfree(temp);
- infoPtr->bmiHeader.biHeight = image->height; /* Bottom-up order */
- } else {
- infoPtr->bmiHeader.biHeight = -image->height; /* Top-down order */
- }
+ infoPtr->bmiHeader.biHeight = -image->height; /* Top-down order */
infoPtr->bmiHeader.biPlanes = 1;
infoPtr->bmiHeader.biBitCount = image->bits_per_pixel;
infoPtr->bmiHeader.biCompression = BI_RGB;
@@ -881,42 +865,8 @@ XDrawLines(display, d, gc, points, npoints, mode)
dc = TkWinGetDrawableDC(display, d, &state);
- if (!tkpIsWin32s && (gc->line_width > 1)) {
- LOGBRUSH lb;
- DWORD style;
-
- lb.lbStyle = BS_SOLID;
- lb.lbColor = gc->foreground;
- lb.lbHatch = 0;
-
- style = PS_GEOMETRIC|PS_COSMETIC;
- switch (gc->cap_style) {
- case CapNotLast:
- case CapButt:
- style |= PS_ENDCAP_FLAT;
- break;
- case CapRound:
- style |= PS_ENDCAP_ROUND;
- break;
- default:
- style |= PS_ENDCAP_SQUARE;
- break;
- }
- switch (gc->join_style) {
- case JoinMiter:
- style |= PS_JOIN_MITER;
- break;
- case JoinRound:
- style |= PS_JOIN_ROUND;
- break;
- default:
- style |= PS_JOIN_BEVEL;
- break;
- }
- pen = ExtCreatePen(style, gc->line_width, &lb, 0, NULL);
- } else {
- pen = CreatePen(PS_SOLID, gc->line_width, gc->foreground);
- }
+ pen = SetUpGraphicsPort(gc);
+ SetBkMode(dc, TRANSPARENT);
RenderObject(dc, gc, points, npoints, mode, pen, Polyline);
DeleteObject(pen);
@@ -1002,7 +952,8 @@ XDrawRectangle(display, d, gc, x, y, width, height)
dc = TkWinGetDrawableDC(display, d, &state);
- pen = CreatePen(PS_SOLID, gc->line_width, gc->foreground);
+ pen = SetUpGraphicsPort(gc);
+ SetBkMode(dc, TRANSPARENT);
oldPen = SelectObject(dc, pen);
oldBrush = SelectObject(dc, GetStockObject(NULL_BRUSH));
SetROP2(dc, tkpWinRopModes[gc->function]);
@@ -1164,7 +1115,7 @@ DrawOrFillArc(display, d, gc, x, y, width, height, start, extent, fill)
* difference in pixel definitions between X and Windows.
*/
- pen = CreatePen(PS_SOLID, gc->line_width, gc->foreground);
+ pen = SetUpGraphicsPort(gc);
oldPen = SelectObject(dc, pen);
if (!fill) {
/*
@@ -1173,6 +1124,7 @@ DrawOrFillArc(display, d, gc, x, y, width, height, start, extent, fill)
* 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);
@@ -1191,6 +1143,92 @@ DrawOrFillArc(display, d, gc, x, y, width, height, start, extent, fill)
/*
*----------------------------------------------------------------------
*
+ * 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
@@ -1262,3 +1300,38 @@ TkWinFillRect(dc, x, y, width, height, pixel)
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/tk/win/tkWinEmbed.c b/tk/win/tkWinEmbed.c
index d30a8663628..55893afa65a 100644
--- a/tk/win/tkWinEmbed.c
+++ b/tk/win/tkWinEmbed.c
@@ -6,7 +6,7 @@
* one application can use as its main window an internal window from
* another application).
*
- * Copyright (c) 1996 Sun Microsystems, Inc.
+ * 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.
@@ -38,9 +38,11 @@ typedef struct Container {
* this process. */
} Container;
-static Container *firstContainerPtr = NULL;
- /* First in list of all containers
+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));
@@ -74,14 +76,16 @@ CleanupContainerList(clientData)
ClientData clientData;
{
Container *nextPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
for (;
- firstContainerPtr != (Container *) NULL;
- firstContainerPtr = nextPtr) {
- nextPtr = firstContainerPtr->nextPtr;
- ckfree((char *) firstContainerPtr);
+ tsdPtr->firstContainerPtr != (Container *) NULL;
+ tsdPtr->firstContainerPtr = nextPtr) {
+ nextPtr = tsdPtr->firstContainerPtr->nextPtr;
+ ckfree((char *) tsdPtr->firstContainerPtr);
}
- firstContainerPtr = (Container *) NULL;
+ tsdPtr->firstContainerPtr = (Container *) NULL;
}
/*
@@ -126,7 +130,7 @@ TkpTestembedCmd(clientData, interp, argc, argv)
* The return value is normally TCL_OK. If an error occurred (such as
* if the argument does not identify a legal Windows window handle),
* the return value is TCL_ERROR and an error message is left in the
- * interp->result if interp is not NULL.
+ * the interp's result if interp is not NULL.
*
* Side effects:
* None.
@@ -147,6 +151,8 @@ TkpUseWindow(interp, tkwin, string)
int id;
HWND hwnd;
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr->window != None) {
panic("TkpUseWindow: Already assigned a window");
@@ -159,7 +165,8 @@ TkpUseWindow(interp, tkwin, string)
/*
* Check if the window is a valid handle. If it is invalid, return
- * TCL_ERROR and potentially leave an error message in interp->result.
+ * TCL_ERROR and potentially leave an error message in the interp's
+ * result.
*/
if (!IsWindow(hwnd)) {
@@ -190,7 +197,7 @@ TkpUseWindow(interp, tkwin, string)
* things will get cleaned up at finalization.
*/
- if (firstContainerPtr == (Container *) NULL) {
+ if (tsdPtr->firstContainerPtr == (Container *) NULL) {
Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
}
@@ -201,8 +208,8 @@ TkpUseWindow(interp, tkwin, string)
* app. are in the same process.
*/
- for (containerPtr = firstContainerPtr; containerPtr != NULL;
- containerPtr = containerPtr->nextPtr) {
+ for (containerPtr = tsdPtr->firstContainerPtr;
+ containerPtr != NULL; containerPtr = containerPtr->nextPtr) {
if (containerPtr->parentHWnd == hwnd) {
winPtr->flags |= TK_BOTH_HALVES;
containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
@@ -213,8 +220,8 @@ TkpUseWindow(interp, tkwin, string)
containerPtr = (Container *) ckalloc(sizeof(Container));
containerPtr->parentPtr = NULL;
containerPtr->parentHWnd = hwnd;
- containerPtr->nextPtr = firstContainerPtr;
- firstContainerPtr = containerPtr;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
}
/*
@@ -258,13 +265,15 @@ TkpMakeContainer(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 (firstContainerPtr == (Container *) NULL) {
+ if (tsdPtr->firstContainerPtr == (Container *) NULL) {
Tcl_CreateExitHandler(CleanupContainerList, (ClientData) NULL);
}
@@ -279,8 +288,8 @@ TkpMakeContainer(tkwin)
containerPtr->parentHWnd = Tk_GetHWND(Tk_WindowId(tkwin));
containerPtr->embeddedHWnd = NULL;
containerPtr->embeddedPtr = NULL;
- containerPtr->nextPtr = firstContainerPtr;
- firstContainerPtr = containerPtr;
+ containerPtr->nextPtr = tsdPtr->firstContainerPtr;
+ tsdPtr->firstContainerPtr = containerPtr;
winPtr->flags |= TK_CONTAINER;
/*
@@ -358,12 +367,14 @@ TkWinEmbeddedEventProc(hwnd, message, wParam, lParam)
LPARAM lParam;
{
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Find the Container structure associated with the parent window.
*/
- for (containerPtr = firstContainerPtr;
+ for (containerPtr = tsdPtr->firstContainerPtr;
containerPtr->parentHWnd != hwnd;
containerPtr = containerPtr->nextPtr) {
if (containerPtr == NULL) {
@@ -508,8 +519,10 @@ TkpGetOtherWindow(winPtr)
* embedded window. */
{
Container *containerPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- for (containerPtr = firstContainerPtr; containerPtr != NULL;
+ for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
containerPtr = containerPtr->nextPtr) {
if (containerPtr->embeddedPtr == winPtr) {
return containerPtr->parentPtr;
@@ -608,6 +621,8 @@ EmbedWindowDeleted(winPtr)
* was deleted. */
{
Container *containerPtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Find the Container structure for this window work. Delete the
@@ -616,7 +631,7 @@ EmbedWindowDeleted(winPtr)
*/
prevPtr = NULL;
- containerPtr = firstContainerPtr;
+ containerPtr = tsdPtr->firstContainerPtr;
while (1) {
if (containerPtr->embeddedPtr == winPtr) {
containerPtr->embeddedHWnd = NULL;
@@ -636,10 +651,11 @@ EmbedWindowDeleted(winPtr)
if ((containerPtr->embeddedPtr == NULL)
&& (containerPtr->parentPtr == NULL)) {
if (prevPtr == NULL) {
- firstContainerPtr = containerPtr->nextPtr;
+ tsdPtr->firstContainerPtr = containerPtr->nextPtr;
} else {
prevPtr->nextPtr = containerPtr->nextPtr;
}
ckfree((char *) containerPtr);
}
}
+
diff --git a/tk/win/tkWinFont.c b/tk/win/tkWinFont.c
index 4f7a8095065..7f6d336ff03 100644
--- a/tk/win/tkWinFont.c
+++ b/tk/win/tkWinFont.c
@@ -4,8 +4,9 @@
* Contains the Windows implementation of the platform-independant
* font package interface.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
* Copyright (c) 1994 Software Research Associates, Inc.
+ * 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.
@@ -17,20 +18,142 @@
#include "tkFont.h"
/*
- * The following structure represents Windows' implementation of a font.
+ * 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. */
- HFONT hFont; /* Windows information about font. */
+ 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. */
+ * 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 used as to map between the Tcl strings
- * that represent the system fonts and the numbers used by Windows.
+ * 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[] = {
@@ -43,30 +166,99 @@ static TkStateMap systemMap[] = {
{-1, NULL}
};
-/* CYGNUS LOCAL: Map magic windows font names into offsets into a
- NONCLIENTMETRICS structure. */
+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;
-static TkStateMap nonClientMap[] = {
- {Tk_Offset(NONCLIENTMETRICS, lfCaptionFont), "caption"},
- {Tk_Offset(NONCLIENTMETRICS, lfSmCaptionFont), "smcaption"},
- {Tk_Offset(NONCLIENTMETRICS, lfMenuFont), "menu"},
- {Tk_Offset(NONCLIENTMETRICS, lfStatusFont), "status"},
- {Tk_Offset(NONCLIENTMETRICS, lfMessageFont), "message"},
- {-1, NULL}
-};
+/*
+ * Information cached about the system at startup time.
+ */
+
+static Tcl_Encoding unicodeEncoding;
+static Tcl_Encoding systemEncoding;
-#define ABS(x) (((x) < 0) ? -(x) : (x))
+/*
+ * 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.
+ *
+ *-------------------------------------------------------------------------
+ */
-static TkFont * AllocFont _ANSI_ARGS_((TkFont *tkFontPtr,
- Tk_Window tkwin, HFONT hFont));
-static char * GetProperty _ANSI_ARGS_((CONST TkFontAttributes *faPtr,
- CONST char *option));
-static int CALLBACK WinFontFamilyEnumProc _ANSI_ARGS_((ENUMLOGFONT *elfPtr,
- NEWTEXTMETRIC *ntmPtr, int fontType,
- LPARAM lParam));
+void
+TkpFontPkgInit(
+ TkMainInfo *mainPtr) /* The application being created. */
+{
+ unicodeEncoding = Tcl_GetEncoding(NULL, "unicode");
+ 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.
+ */
-/* CYGNUS LOCAL: New static function. */
-static int FontChanged _ANSI_ARGS_((TkFontAttributes *faPtr));
+ systemEncoding = unicodeEncoding;
+ }
+}
/*
*---------------------------------------------------------------------------
@@ -89,29 +281,29 @@ static int FontChanged _ANSI_ARGS_((TkFontAttributes *faPtr));
* the contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
- * None.
+ * Memory allocated.
*
*---------------------------------------------------------------------------
*/
TkFont *
-TkpGetNativeFont(tkwin, name)
- Tk_Window tkwin; /* For display where font will be used. */
- CONST char *name; /* Platform-specific font name. */
+TkpGetNativeFont(
+ Tk_Window tkwin, /* For display where font will be used. */
+ CONST char *name) /* Platform-specific font name. */
{
int object;
- HFONT hFont;
-
+ WinFont *fontPtr;
+
object = TkFindStateNum(NULL, NULL, systemMap, name);
if (object < 0) {
return NULL;
}
- hFont = GetStockObject(object);
- if (hFont == NULL) {
- panic("TkpGetNativeFont: can't allocate stock font");
- }
- return AllocFont(NULL, tkwin, hFont);
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
+ fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ InitFont(tkwin, GetStockObject(object), 0, fontPtr);
+
+ return (TkFont *) fontPtr;
}
/*
@@ -138,97 +330,86 @@ TkpGetNativeFont(tkwin, name)
* the contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
- * None.
+ * Memory allocated.
*
*---------------------------------------------------------------------------
*/
+
TkFont *
-TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
- TkFont *tkFontPtr; /* If non-NULL, store the information in
+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. */
+ Tk_Window tkwin, /* For display where font will be used. */
+ CONST TkFontAttributes *faPtr)
+ /* Set of attributes to match. */
{
- int offset;
- LOGFONT lf;
+ int i, j;
+ HDC hdc;
+ HWND hwnd;
HFONT hFont;
Window window;
- HWND hwnd;
- HDC hdc;
-
- /* CYGNUS LOCAL: Magic handling for fonts in the windows-* family. */
- if (faPtr->family != NULL
- && strncmp(faPtr->family, "windows-", 8) == 0
- && (offset = TkFindStateNum(NULL, NULL, nonClientMap,
- faPtr->family + 8)) >= 0) {
- NONCLIENTMETRICS ncm;
-
- ncm.cbSize = sizeof(ncm);
- if (! SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncm),
- (void *) &ncm, 0)) {
- panic("TkpGetFontFromAttributes: SystemParametersInfo failed");
- }
-
- lf = *(LOGFONT *)((char *) &ncm + offset);
- } else {
- window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr);
- hwnd = (window == None) ? NULL : TkWinGetHWND(window);
-
- hdc = GetDC(hwnd);
- lf.lfHeight = -faPtr->pointsize;
- if (lf.lfHeight < 0) {
- lf.lfHeight = MulDiv(lf.lfHeight,
- 254 * WidthOfScreen(Tk_Screen(tkwin)),
- 720 * WidthMMOfScreen(Tk_Screen(tkwin)));
+ WinFont *fontPtr;
+ char ***fontFallbacks;
+ char *faceName, *fallback, *actualName;
+
+ tkwin = (Tk_Window) ((TkWindow *) tkwin)->mainPtr->winPtr;
+ window = Tk_WindowId(tkwin);
+ hwnd = (window == None) ? NULL : TkWinGetHWND(window);
+ hdc = GetDC(hwnd);
+
+ /*
+ * Algorithm to get the closest font name to the one requested.
+ *
+ * try fontname
+ * try all aliases for fontname
+ * foreach fallback for fontname
+ * try the fallback
+ * try all aliases for the fallback
+ */
+
+ faceName = faPtr->family;
+ if (faceName != NULL) {
+ actualName = FamilyOrAliasExists(hdc, faceName);
+ if (actualName != NULL) {
+ faceName = actualName;
+ goto found;
}
- lf.lfWidth = 0;
- lf.lfEscapement = 0;
- lf.lfOrientation = 0;
- lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
- lf.lfItalic = faPtr->slant;
- lf.lfUnderline = faPtr->underline;
- lf.lfStrikeOut = faPtr->overstrike;
- lf.lfCharSet = DEFAULT_CHARSET;
- lf.lfOutPrecision = OUT_DEFAULT_PRECIS;
- lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
- lf.lfQuality = DEFAULT_QUALITY;
- lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
- if (faPtr->family == NULL) {
- lf.lfFaceName[0] = '\0';
- } else {
- lstrcpyn(lf.lfFaceName, faPtr->family, sizeof(lf.lfFaceName));
+ 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;
+ }
+ }
+ }
}
- ReleaseDC(hwnd, hdc);
+ }
- /*
- * Replace the standard X and Mac family names with the names that
- * Windows likes.
- */
+ found:
+ ReleaseDC(hwnd, hdc);
- if ((stricmp(lf.lfFaceName, "Times") == 0)
- || (stricmp(lf.lfFaceName, "New York") == 0)) {
- strcpy(lf.lfFaceName, "Times New Roman");
- } else if ((stricmp(lf.lfFaceName, "Courier") == 0)
- || (stricmp(lf.lfFaceName, "Monaco") == 0)) {
- strcpy(lf.lfFaceName, "Courier New");
- } else if ((stricmp(lf.lfFaceName, "Helvetica") == 0)
- || (stricmp(lf.lfFaceName, "Geneva") == 0)) {
- strcpy(lf.lfFaceName, "Arial");
- }
+ hFont = 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);
- hFont = CreateFontIndirect(&lf);
- if (hFont == NULL) {
- hFont = GetStockObject(SYSTEM_FONT);
- if (hFont == NULL) {
- panic("TkpGetFontFromAttributes: cannot get system font");
- }
- }
- return AllocFont(tkFontPtr, tkwin, hFont);
+ return (TkFont *) fontPtr;
}
/*
@@ -251,26 +432,25 @@ TkpGetFontFromAttributes(tkFontPtr, tkwin, faPtr)
*/
void
-TkpDeleteFont(tkFontPtr)
- TkFont *tkFontPtr; /* Token of font to be deleted. */
+TkpDeleteFont(
+ TkFont *tkFontPtr) /* Token of font to be deleted. */
{
WinFont *fontPtr;
fontPtr = (WinFont *) tkFontPtr;
- DeleteObject(fontPtr->hFont);
- ckfree((char *) fontPtr);
+ ReleaseFont(fontPtr);
}
/*
*---------------------------------------------------------------------------
*
- * TkpGetFontFamilies, WinFontEnumFamilyProc --
+ * TkpGetFontFamilies, WinFontFamilyEnumProc --
*
* Return information about the font families that are available
* on the display of the given window.
*
* Results:
- * interp->result is modified to hold a list of all the available
+ * Modifies interp's result object to hold a list of all the available
* font families.
*
* Side effects:
@@ -280,51 +460,114 @@ TkpDeleteFont(tkFontPtr)
*/
void
-TkpGetFontFamilies(interp, tkwin)
- Tcl_Interp *interp; /* Interp to hold result. */
- Tk_Window tkwin; /* For display to query. */
+TkpGetFontFamilies(
+ Tcl_Interp *interp, /* Interp to hold result. */
+ Tk_Window tkwin) /* For display to query. */
{
- Window window;
- HWND hwnd;
HDC hdc;
+ HWND hwnd;
+ Window window;
- window = Tk_WindowId(tkwin);
- hwnd = (window == (Window) NULL) ? NULL : TkWinGetHWND(window);
-
- hdc = GetDC(hwnd);
- EnumFontFamilies(hdc, NULL, (FONTENUMPROC) WinFontFamilyEnumProc,
- (LPARAM) interp);
+ 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);
}
-/* ARGSUSED */
-
static int CALLBACK
-WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam)
- ENUMLOGFONT *elfPtr; /* Logical-font data. */
- NEWTEXTMETRIC *ntmPtr; /* Physical-font data (not used). */
- int fontType; /* Type of font (not used). */
- LPARAM lParam; /* Interp to hold result. */
+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;
- Tcl_AppendElement(interp, elfPtr->elfLogFont.lfFaceName);
+ 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 characters from the string that will fit
+ * 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 characters from source that
+ * 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.
@@ -334,123 +577,204 @@ WinFontFamilyEnumProc(elfPtr, ntmPtr, fontType, lParam)
*
*---------------------------------------------------------------------------
*/
+
int
-Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
- Tk_Font tkfont; /* Font in which characters will be drawn. */
- CONST char *source; /* Characters to be displayed. Need not be
+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 numChars; /* Maximum number of characters to consider
+ 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
+ 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:
+ 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
+ int *lengthPtr) /* Filled with x-location just after the
* terminating character. */
{
- WinFont *fontPtr;
HDC hdc;
- HFONT hFont;
- int curX, curIdx;
+ 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);
- hFont = SelectObject(hdc, fontPtr->hFont);
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
- if (numChars == 0) {
+ if (numBytes == 0) {
curX = 0;
- curIdx = 0;
- } else if (maxLength <= 0) {
+ curByte = 0;
+ } else if (maxLength < 0) {
+ Tcl_UniChar ch;
SIZE size;
-
- GetTextExtentPoint32(hdc, source, numChars, &size);
- curX = size.cx;
- curIdx = numChars;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+ SubFont *thisSubFontPtr;
+ CONST char *p, *end, *next;
+
+ /*
+ * A three step process:
+ * 1. Find a contiguous range of characters that can all be
+ * represented by a single screen font.
+ * 2. Convert those chars to the encoding of that font.
+ * 3. Measure converted chars.
+ */
+
+ curX = 0;
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ curX += size.cx;
+ Tcl_DStringFree(&runString);
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+
+ SelectObject(hdc, lastSubFontPtr->hFont);
+ }
+ p = next;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ curX += size.cx;
+ Tcl_DStringFree(&runString);
+ curByte = numBytes;
} else {
- int max;
- int *partials;
+ Tcl_UniChar ch;
SIZE size;
-
- partials = (int *) ckalloc(numChars * sizeof (int));
- GetTextExtentExPoint(hdc, source, numChars, maxLength, &max,
- partials, &size);
-
- if ((flags & TK_WHOLE_WORDS) && max < numChars) {
- int sawSpace;
- int i;
-
- sawSpace = 0;
- i = max;
- while (i >= 0 && !isspace(source[i])) {
- --i;
- }
- while (i >= 0 && isspace(source[i])) {
- sawSpace = 1;
- --i;
- }
+ char buf[16];
+ FontFamily *familyPtr;
+ SubFont *thisSubFontPtr;
+ CONST char *term, *end, *p, *next;
+ int newX, termX, sawNonSpace, dstWrote;
- /*
- * If a space char was not found, and the flag for forcing
- * at least on (or more) chars to be drawn is false, then
- * set MAX to zero so no text is drawn. Otherwise, if a
- * space was found, set max to be one char past the space.
- */
-
- if ((i < 0) && !(flags & TK_AT_LEAST_ONE)) {
- max = 0;
- } else if (sawSpace) {
- max = i + 1;
+ /*
+ * How many chars will fit in the space allotted?
+ * This first version may be inefficient because it measures
+ * every character individually. There is a function call that
+ * can measure multiple characters at once and return the
+ * offset of each of them, but it only works on NT, even though
+ * the documentation claims it works for 95.
+ * TODO: verify that GetTextExtentExPoint is still broken in '95, and
+ * possibly use it for NT anyway since it should be much faster and
+ * more accurate.
+ */
+
+ next = source + Tcl_UtfToUniChar(source, &ch);
+ newX = curX = termX = 0;
+
+ term = source;
+ end = source + numBytes;
+
+ sawNonSpace = (ch > 255) || !isspace(ch);
+ for (p = source; ; ) {
+ if (ch < BASE_CHARS) {
+ newX += fontPtr->widths[ch];
+ } else {
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ SelectObject(hdc, thisSubFontPtr->hFont);
+ lastSubFontPtr = thisSubFontPtr;
+ }
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternal(NULL, familyPtr->encoding, p, next - p,
+ 0, NULL, buf, sizeof(buf), 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;
}
-
- }
- if (max == 0) {
- curX = 0;
- } else {
- curX = partials[max - 1];
+ next += Tcl_UtfToUniChar(next, &ch);
+ if ((ch < 256) && isspace(ch)) {
+ if (sawNonSpace) {
+ term = p;
+ termX = curX;
+ sawNonSpace = 0;
+ }
+ } else {
+ sawNonSpace = 1;
+ }
}
- if (((flags & TK_PARTIAL_OK) && max < numChars && curX < maxLength)
- || ((flags & TK_AT_LEAST_ONE) && max == 0 && numChars > 0)) {
- /* CYGNUS LOCAL - BUG ALERT - We have to pass the bogus length, and
- the dummyMax parameter, because without them the call crashes on
- NT/J Service Pack 3 and less. This is documented in the
- Microsoft Knowledge Base. */
-
- int dummyMax;
+ /*
+ * 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)) {
/*
- * We want to include the first character that didn't
- * quite fit. Call the function again to include the
- * width of the extra character.
- */
-
- GetTextExtentExPoint(hdc, source, max + 1, INT_MAX, &dummyMax,
- partials, &size);
- curX = partials[max];
- ++max;
-
- }
-
- ckfree((char *) partials);
- curIdx = max;
+ * Include the first character that didn't quite fit in the desired
+ * span. The width returned will include the width of that extra
+ * character.
+ */
+
+ curX = newX;
+ p += Tcl_UtfToUniChar(p, &ch);
+ }
+ if ((flags & TK_AT_LEAST_ONE) && (term == source) && (p < end)) {
+ term = p;
+ termX = curX;
+ if (term == source) {
+ term += Tcl_UtfToUniChar(term, &ch);
+ termX = newX;
+ }
+ } else if ((p >= end) || !(flags & TK_WHOLE_WORDS)) {
+ term = p;
+ termX = curX;
+ }
+
+ curX = termX;
+ curByte = term - source;
}
- SelectObject(hdc, hFont);
+ SelectObject(hdc, oldFont);
ReleaseDC(fontPtr->hwnd, hdc);
*lengthPtr = curX;
- return curIdx;
+ return curByte;
}
/*
@@ -470,27 +794,26 @@ Tk_MeasureChars(tkfont, source, numChars, maxLength, flags, lengthPtr)
*/
void
-Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
- Display *display; /* Display on which to draw. */
- Drawable drawable; /* Window or pixmap in which to draw. */
- GC gc; /* Graphics context for drawing characters. */
- Tk_Font tkfont; /* Font in which characters will be drawn;
+Tk_DrawChars(
+ Display *display, /* Display on which to draw. */
+ Drawable drawable, /* Window or pixmap in which to draw. */
+ GC gc, /* Graphics context for drawing characters. */
+ Tk_Font tkfont, /* Font in which characters will be drawn;
* must be the same as font used in GC. */
- CONST char *source; /* Characters to be displayed. Need not be
+ 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 numChars; /* Number of characters in string. */
- int x, y; /* Coordinates at which to place origin of
+ int numBytes, /* Number of bytes in string. */
+ int x, int y) /* Coordinates at which to place origin of
* string when drawing. */
{
HDC dc;
- HFONT hFont;
- TkWinDCState state;
WinFont *fontPtr;
+ TkWinDCState state;
fontPtr = (WinFont *) gc->font;
display->request++;
@@ -527,18 +850,16 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
oldBrush = SelectObject(dc, stipple);
- SetTextAlign(dcMem, TA_LEFT | TA_TOP);
+ SetTextAlign(dcMem, TA_LEFT | TA_BASELINE);
SetTextColor(dcMem, gc->foreground);
SetBkMode(dcMem, TRANSPARENT);
SetBkColor(dcMem, RGB(0, 0, 0));
- hFont = SelectObject(dcMem, fontPtr->hFont);
-
/*
* Compute the bounding box and create a compatible bitmap.
*/
- GetTextExtentPoint(dcMem, source, numChars, &size);
+ GetTextExtentPoint(dcMem, source, numBytes, &size);
GetTextMetrics(dcMem, &tm);
size.cx -= tm.tmOverhang;
bitmap = CreateCompatibleBitmap(dc, size.cx, size.cy);
@@ -553,11 +874,11 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
*/
PatBlt(dcMem, 0, 0, size.cx, size.cy, BLACKNESS);
- TextOut(dcMem, 0, 0, source, numChars);
+ 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);
- TextOut(dcMem, 0, 0, source, numChars);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
BitBlt(dc, x, y - tm.tmAscent, size.cx, size.cy, dcMem,
0, 0, 0x8A0E06);
@@ -565,7 +886,6 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
* Destroy the temporary bitmap and restore the device context.
*/
- SelectObject(dcMem, hFont);
SelectObject(dcMem, oldBitmap);
DeleteObject(bitmap);
DeleteDC(dcMem);
@@ -575,115 +895,1474 @@ Tk_DrawChars(display, drawable, gc, tkfont, source, numChars, x, y)
SetTextAlign(dc, TA_LEFT | TA_BASELINE);
SetTextColor(dc, gc->foreground);
SetBkMode(dc, TRANSPARENT);
- hFont = SelectObject(dc, fontPtr->hFont);
- TextOut(dc, x, y, source, numChars);
- SelectObject(dc, hFont);
+ MultiFontTextOut(dc, fontPtr, source, numBytes, x, y);
}
TkWinReleaseDrawableDC(drawable, dc, &state);
}
/*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * AllocFont --
+ * MultiFontTextOut --
*
- * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
- * Allocates and intializes the memory for a new TkFont that
- * wraps the platform-specific data.
+ * Helper function for Tk_DrawChars. Draws characters, using the
+ * various screen fonts in fontPtr to draw multilingual characters.
+ * Note: No bidirectional support.
*
* Results:
- * Returns pointer to newly constructed TkFont.
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ * Contents of fontPtr may be modified if more subfonts were loaded
+ * in order to draw all the multilingual characters in the given
+ * string.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+MultiFontTextOut(
+ HDC hdc, /* HDC to draw into. */
+ WinFont *fontPtr, /* Contains set of fonts to use when drawing
+ * following string. */
+ CONST char *source, /* Potentially multilingual UTF-8 string. */
+ int numBytes, /* Length of string in bytes. */
+ int x, int y) /* Coordinates at which to place origin *
+ * of string when drawing. */
+{
+ Tcl_UniChar ch;
+ SIZE size;
+ HFONT oldFont;
+ FontFamily *familyPtr;
+ Tcl_DString runString;
+ CONST char *p, *end, *next;
+ SubFont *lastSubFontPtr, *thisSubFontPtr;
+
+ lastSubFontPtr = &fontPtr->subFontArray[0];
+ oldFont = SelectObject(hdc, lastSubFontPtr->hFont);
+
+ end = source + numBytes;
+ for (p = source; p < end; ) {
+ next = p + Tcl_UtfToUniChar(p, &ch);
+ thisSubFontPtr = FindSubFontForChar(fontPtr, ch);
+ if (thisSubFontPtr != lastSubFontPtr) {
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source,
+ p - source, &runString);
+ (*familyPtr->textOutProc)(hdc, x, y,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
+ (*familyPtr->getTextExtentPoint32Proc)(hdc,
+ Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont,
+ &size);
+ x += size.cx;
+ Tcl_DStringFree(&runString);
+ }
+ lastSubFontPtr = thisSubFontPtr;
+ source = p;
+ SelectObject(hdc, lastSubFontPtr->hFont);
+ }
+ p = next;
+ }
+ if (p > source) {
+ familyPtr = lastSubFontPtr->familyPtr;
+ Tcl_UtfToExternalDString(familyPtr->encoding, source, p - source,
+ &runString);
+ (*familyPtr->textOutProc)(hdc, x, y, Tcl_DStringValue(&runString),
+ Tcl_DStringLength(&runString) >> familyPtr->isWideFont);
+ Tcl_DStringFree(&runString);
+ }
+ SelectObject(hdc, oldFont);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitFont --
+ *
+ * Helper for TkpGetNativeFont() and TkpGetFontFromAttributes().
+ * Initializes the memory for a new WinFont that wraps the
+ * platform-specific data.
*
* The caller is responsible for initializing the fields of the
- * TkFont that are used exclusively by the generic TkFont code, and
+ * 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 TkFont *
-AllocFont(tkFontPtr, tkwin, hFont)
- TkFont *tkFontPtr; /* If non-NULL, store the information in
- * this existing TkFont structure, rather than
- * allocating a new structure to hold the
- * font; the existing contents of the font
- * will be released. If NULL, a new TkFont
- * structure is allocated. */
- Tk_Window tkwin; /* For display where font will be used. */
- HFONT hFont; /* Windows information about font. */
+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. */
{
- HWND hwnd;
- WinFont *fontPtr;
HDC hdc;
+ HWND hwnd;
+ HFONT oldFont;
TEXTMETRIC tm;
Window window;
- char buf[LF_FACESIZE];
+ 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);
- if (tkFontPtr != NULL) {
- fontPtr = (WinFont *) tkFontPtr;
- DeleteObject(fontPtr->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 {
- fontPtr = (WinFont *) ckalloc(sizeof(WinFont));
+ GetTextFaceA(hdc, LF_FACESIZE, (char *) buf);
}
-
- window = Tk_WindowId(((TkWindow *) tkwin)->mainPtr->winPtr);
- hwnd = (window == None) ? NULL : TkWinGetHWND(window);
-
- hdc = GetDC(hwnd);
- hFont = SelectObject(hdc, hFont);
- GetTextFace(hdc, sizeof(buf), buf);
- GetTextMetrics(hdc, &tm);
+ Tcl_ExternalToUtfDString(systemEncoding, buf, -1, &faceString);
fontPtr->font.fid = (Font) fontPtr;
- faPtr = &fontPtr->font.fa;
- faPtr->family = Tk_GetUid(buf);
- faPtr->pointsize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
- 720 * WidthMMOfScreen(Tk_Screen(tkwin)),
- 254 * WidthOfScreen(Tk_Screen(tkwin)));
+ faPtr = &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 = (tm.tmStruckOut != 0) ? 1 : 0;
+ faPtr->overstrike = overstrike;
+
+ fmPtr = &fontPtr->font.fm;
+ fmPtr->ascent = tm.tmAscent;
+ fmPtr->descent = tm.tmDescent;
+ fmPtr->maxWidth = tm.tmMaxCharWidth;
+ fmPtr->fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);
+
+ fontPtr->hwnd = hwnd;
+ fontPtr->pixelSize = tm.tmHeight - tm.tmInternalLeading;
+
+ fontPtr->numSubFonts = 1;
+ fontPtr->subFontArray = fontPtr->staticSubFonts;
+ InitSubFont(hdc, hFont, 1, &fontPtr->subFontArray[0]);
+
+ encoding = fontPtr->subFontArray[0].familyPtr->encoding;
+ if (encoding == unicodeEncoding) {
+ GetCharWidthW(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ } else {
+ GetCharWidthA(hdc, 0, BASE_CHARS - 1, fontPtr->widths);
+ }
+ Tcl_DStringFree(&faceString);
+
+ SelectObject(hdc, oldFont);
+ ReleaseDC(hwnd, hdc);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReleaseFont --
+ *
+ * Called to release the windows-specific contents of a TkFont.
+ * The caller is responsible for freeing the memory used by the
+ * font itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ReleaseFont(
+ WinFont *fontPtr) /* The font to delete. */
+{
+ int i;
- fontPtr->font.fm.ascent = tm.tmAscent;
- fontPtr->font.fm.descent = tm.tmDescent;
- fontPtr->font.fm.maxWidth = tm.tmMaxCharWidth;
- fontPtr->font.fm.fixed = !(tm.tmPitchAndFamily & TMPF_FIXED_PITCH);
+ 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);
- ReleaseDC(hwnd, hdc);
+ 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);
- fontPtr->hFont = hFont;
- fontPtr->hwnd = hwnd;
+ familyPtr = tsdPtr->fontFamilyList;
+ for ( ; familyPtr != NULL; familyPtr = familyPtr->nextPtr) {
+ if (familyPtr->faceName == faceName) {
+ familyPtr->refCount++;
+ return familyPtr;
+ }
+ }
- return (TkFont *) fontPtr;
+ 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;
}
-/* CYGNUS LOCAL: This function is called when one of the non client
- metrics changes. We don't expect this to happen very often, so we
- always try to update all the known fonts. */
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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));
-void
-TkWinNCMetricsChanged(tkwin)
- Tk_Window tkwin;
+ if (familyPtr == NULL) {
+ return;
+ }
+ familyPtr->refCount--;
+ if (familyPtr->refCount > 0) {
+ return;
+ }
+ for (i = 0; i < FONTMAP_PAGES; i++) {
+ if (familyPtr->fontMap[i] != NULL) {
+ ckfree(familyPtr->fontMap[i]);
+ }
+ }
+ if (familyPtr->startCount != NULL) {
+ ckfree((char *) familyPtr->startCount);
+ }
+ if (familyPtr->endCount != NULL) {
+ ckfree((char *) familyPtr->endCount);
+ }
+ if (familyPtr->encoding != unicodeEncoding) {
+ Tcl_FreeEncoding(familyPtr->encoding);
+ }
+
+ /*
+ * Delete from list.
+ */
+
+ for (familyPtrPtr = &tsdPtr->fontFamilyList; ; ) {
+ if (*familyPtrPtr == familyPtr) {
+ *familyPtrPtr = familyPtr->nextPtr;
+ break;
+ }
+ familyPtrPtr = &(*familyPtrPtr)->nextPtr;
+ }
+
+ ckfree((char *) familyPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FindSubFontForChar --
+ *
+ * Determine which screen font is necessary to use to display the
+ * given character. If the font object does not have a screen font
+ * that can display the character, another screen font may be loaded
+ * into the font object, following a set of preferred fallback rules.
+ *
+ * Results:
+ * The return value is the SubFont to use to display the given
+ * character.
+ *
+ * Side effects:
+ * The contents of fontPtr are modified to cache the results
+ * of the lookup and remember any SubFonts that were dynamically
+ * loaded.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+FindSubFontForChar(
+ WinFont *fontPtr, /* The font object with which the character
+ * will be displayed. */
+ int ch) /* The Unicode character to be displayed. */
{
- TkUpdateFonts(tkwin, FontChanged);
+ 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;
}
-/* This function returns non-zero when passed a font in a magic
- Windows non client font. */
+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
-FontChanged(faPtr)
- TkFontAttributes *faPtr;
+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. */
{
- return (faPtr->family != NULL
- && strncmp(faPtr->family, "windows-", 8) == 0
- && TkFindStateNum(NULL, NULL, nonClientMap,
- faPtr->family + 8) >= 0);
+ int row, bitOffset;
+
+ row = ch >> FONTMAP_SHIFT;
+ if (subFontPtr->fontMap[row] == NULL) {
+ FontMapLoadPage(subFontPtr, row);
+ }
+ bitOffset = ch & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * FontMapLoadPage --
+ *
+ * Load information about all the characters on a given page.
+ * This information consists of one bit per character that indicates
+ * whether the associated HFONT can (1) or cannot (0) display the
+ * characters on the page.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Mempry allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+static void
+FontMapLoadPage(
+ SubFont *subFontPtr, /* Contains font mapping cache to be
+ * updated. */
+ int row) /* Index of the page to be loaded into
+ * the cache. */
+{
+ FontFamily *familyPtr;
+ Tcl_Encoding encoding;
+ char src[TCL_UTF_MAX], buf[16];
+ USHORT *startCount, *endCount;
+ int i, j, bitOffset, end, segCount;
+
+ subFontPtr->fontMap[row] = (char *) ckalloc(FONTMAP_BITSPERPAGE / 8);
+ memset(subFontPtr->fontMap[row], 0, FONTMAP_BITSPERPAGE / 8);
+
+ familyPtr = subFontPtr->familyPtr;
+ encoding = familyPtr->encoding;
+
+ if (familyPtr->encoding == unicodeEncoding) {
+ /*
+ * Font is Unicode. Few fonts are going to have all characters, so
+ * examine the TrueType character existence metrics to determine
+ * what characters actually exist in this font.
+ */
+
+ segCount = familyPtr->segCount;
+ startCount = familyPtr->startCount;
+ endCount = familyPtr->endCount;
+
+ j = 0;
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ for ( ; j < segCount; j++) {
+ if (endCount[j] >= i) {
+ if (startCount[j] <= i) {
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ break;
+ }
+ }
+ }
+ } else if (familyPtr->isSymbolFont) {
+ /*
+ * Assume that a symbol font with a known encoding has all the
+ * characters that its encoding claims it supports.
+ *
+ * The test for "encoding == unicodeEncoding"
+ * must occur before this case, to catch all symbol fonts (such
+ * as {Comic Sans MS} or Wingdings) for which we don't have
+ * encoding information; those symbol fonts are treated as if
+ * they were in the Unicode encoding and their symbolic
+ * character existence metrics are treated as if they were Unicode
+ * character existence metrics. This way, although we don't know
+ * the proper Unicode -> symbol font mapping, we can install the
+ * symbol font as the base font and access its glyphs.
+ */
+
+ end = (row + 1) << FONTMAP_SHIFT;
+ for (i = row << FONTMAP_SHIFT; i < end; i++) {
+ if (Tcl_UtfToExternal(NULL, encoding, src,
+ Tcl_UniCharToUtf(i, src), TCL_ENCODING_STOPONERROR, NULL,
+ buf, sizeof(buf), NULL, NULL, NULL) != TCL_OK) {
+ continue;
+ }
+ bitOffset = i & (FONTMAP_BITSPERPAGE - 1);
+ subFontPtr->fontMap[row][bitOffset >> 3] |= 1 << (bitOffset & 7);
+ }
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanUseFallbackWithAliases --
+ *
+ * Helper function for FindSubFontForChar. Determine if the
+ * specified face name (or an alias of the specified face name)
+ * can be used to construct a screen font that can display the
+ * given character.
+ *
+ * Results:
+ * See CanUseFallback().
+ *
+ * Side effects:
+ * If the name and/or one of its aliases was rejected, the
+ * rejected string is recorded in nameTriedPtr so that it won't
+ * be tried again.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallbackWithAliases(
+ HDC hdc, /* HDC in which font can be selected. */
+ WinFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch, /* The Unicode character that the new
+ * screen font must be able to display. */
+ Tcl_DString *nameTriedPtr) /* Records face names that have already
+ * been tried. It is possible for the same
+ * face name to be queried multiple times when
+ * trying to find a suitable screen font. */
+{
+ int i;
+ char **aliases;
+ SubFont *subFontPtr;
+
+ if (SeenName(faceName, nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, faceName, ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ aliases = TkFontGetAliasList(faceName);
+ if (aliases != NULL) {
+ for (i = 0; aliases[i] != NULL; i++) {
+ if (SeenName(aliases[i], nameTriedPtr) == 0) {
+ subFontPtr = CanUseFallback(hdc, fontPtr, aliases[i], ch);
+ if (subFontPtr != NULL) {
+ return subFontPtr;
+ }
+ }
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SeenName --
+ *
+ * Used to determine we have already tried and rejected the given
+ * face name when looking for a screen font that can support some
+ * Unicode character.
+ *
+ * Results:
+ * The return value is 0 if this face name has not already been seen,
+ * non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SeenName(
+ CONST char *name, /* The name to check. */
+ Tcl_DString *dsPtr) /* Contains names that have already been
+ * seen. */
+{
+ CONST char *seen, *end;
+
+ seen = Tcl_DStringValue(dsPtr);
+ end = seen + Tcl_DStringLength(dsPtr);
+ while (seen < end) {
+ if (strcasecmp(seen, name) == 0) {
+ return 1;
+ }
+ seen += strlen(seen) + 1;
+ }
+ Tcl_DStringAppend(dsPtr, (char *) name, (int) (strlen(name) + 1));
+ return 0;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanUseFallback --
+ *
+ * If the specified screen font has not already been loaded into
+ * the font object, determine if it can display the given character.
+ *
+ * Results:
+ * The return value is a pointer to a newly allocated SubFont, owned
+ * by the font object. This SubFont can be used to display the given
+ * character. The SubFont represents the screen font with the base set
+ * of font attributes from the font object, but using the specified
+ * font name. NULL is returned if the font object already holds
+ * a reference to the specified physical font or if the specified
+ * physical font cannot display the given character.
+ *
+ * Side effects:
+ * The font object's subFontArray is updated to contain a reference
+ * to the newly allocated SubFont.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static SubFont *
+CanUseFallback(
+ HDC hdc, /* HDC in which font can be selected. */
+ WinFont *fontPtr, /* The font object that will own the new
+ * screen font. */
+ char *faceName, /* Desired face name for new screen font. */
+ int ch) /* The Unicode character that the new
+ * screen font must be able to display. */
+{
+ int i;
+ HFONT hFont;
+ SubFont subFont;
+
+ if (FamilyExists(hdc, faceName) == 0) {
+ return NULL;
+ }
+
+ /*
+ * Skip all fonts we've already used.
+ */
+
+ for (i = 0; i < fontPtr->numSubFonts; i++) {
+ if (faceName == fontPtr->subFontArray[i].familyPtr->faceName) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Load this font and see if it has the desired character.
+ */
+
+ hFont = GetScreenFont(&fontPtr->font.fa, faceName, fontPtr->pixelSize);
+ InitSubFont(hdc, hFont, 0, &subFont);
+ if (((ch < 256) && (subFont.familyPtr->isSymbolFont))
+ || (FontMapLookup(&subFont, ch) == 0)) {
+ /*
+ * Don't use a symbol font as a fallback font for characters below
+ * 256.
+ */
+
+ ReleaseSubFont(&subFont);
+ return NULL;
+ }
+
+ if (fontPtr->numSubFonts >= SUBFONT_SPACE) {
+ SubFont *newPtr;
+
+ newPtr = (SubFont *) ckalloc(sizeof(SubFont)
+ * (fontPtr->numSubFonts + 1));
+ memcpy((char *) newPtr, fontPtr->subFontArray,
+ fontPtr->numSubFonts * sizeof(SubFont));
+ if (fontPtr->subFontArray != fontPtr->staticSubFonts) {
+ ckfree((char *) fontPtr->subFontArray);
+ }
+ fontPtr->subFontArray = newPtr;
+ }
+ fontPtr->subFontArray[fontPtr->numSubFonts] = subFont;
+ fontPtr->numSubFonts++;
+ return &fontPtr->subFontArray[fontPtr->numSubFonts - 1];
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetScreenFont --
+ *
+ * Given the name and other attributes, construct an HFONT.
+ * This is where all the alias and fallback substitution bottoms
+ * out.
+ *
+ * Results:
+ * The screen font that corresponds to the attributes.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static HFONT
+GetScreenFont(
+ CONST TkFontAttributes *faPtr,
+ /* Desired font attributes for new HFONT. */
+ CONST char *faceName, /* Overrides font family specified in font
+ * attributes. */
+ int pixelSize) /* Overrides size specified in font
+ * attributes. */
+{
+ Tcl_DString ds;
+ HFONT hFont;
+ LOGFONTW lf;
+
+ lf.lfHeight = -pixelSize;
+ lf.lfWidth = 0;
+ lf.lfEscapement = 0;
+ lf.lfOrientation = 0;
+ lf.lfWeight = (faPtr->weight == TK_FW_NORMAL) ? FW_NORMAL : FW_BOLD;
+ lf.lfItalic = faPtr->slant;
+ lf.lfUnderline = faPtr->underline;
+ lf.lfStrikeOut = faPtr->overstrike;
+ lf.lfCharSet = DEFAULT_CHARSET;
+ lf.lfOutPrecision = OUT_TT_PRECIS;
+ lf.lfClipPrecision = CLIP_DEFAULT_PRECIS;
+ lf.lfQuality = DEFAULT_QUALITY;
+ lf.lfPitchAndFamily = DEFAULT_PITCH | FF_DONTCARE;
+
+ Tcl_UtfToExternalDString(systemEncoding, faceName, -1, &ds);
+
+ if (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;
+ }
+ }
+ }
+ }
+ }
+ }
+ 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/tk/win/tkWinImage.c b/tk/win/tkWinImage.c
index dca6583b669..7cbdfde9036 100644
--- a/tk/win/tkWinImage.c
+++ b/tk/win/tkWinImage.c
@@ -35,7 +35,7 @@ static int PutPixel _ANSI_ARGS_((XImage *image, int x, int y,
*----------------------------------------------------------------------
*/
-int
+static int
DestroyImage(imagePtr)
XImage *imagePtr; /* image to free */
{
@@ -64,7 +64,7 @@ DestroyImage(imagePtr)
*----------------------------------------------------------------------
*/
-unsigned long
+static unsigned long
ImageGetPixel(image, x, y)
XImage *image;
int x, y;
@@ -327,3 +327,4 @@ XGetImage(display, d, x, y, width, height, plane_mask, format)
return imagePtr;
}
+
diff --git a/tk/win/tkWinInit.c b/tk/win/tkWinInit.c
index 4ddfd56cb4e..29f2246c977 100644
--- a/tk/win/tkWinInit.c
+++ b/tk/win/tkWinInit.c
@@ -43,6 +43,12 @@ 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);
}
@@ -116,6 +122,19 @@ TkpDisplayWarning(msg, title)
char *msg; /* Message to be displayed. */
char *title; /* Title of warning. */
{
- MessageBox(NULL, msg, title, MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
- | MB_SETFOREGROUND | MB_TOPMOST);
+ int l;
+
+ if ( GetStdHandle(STD_ERROR_HANDLE) != INVALID_HANDLE_VALUE &&
+ GetFileType(GetStdHandle(STD_ERROR_HANDLE)) != FILE_TYPE_UNKNOWN ) {
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), title, strlen(title), &l, NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), ": " , 2 , &l, NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg , strlen(msg) , &l, NULL);
+ WriteFile(GetStdHandle(STD_ERROR_HANDLE), "\n" , 1 , &l, NULL);
+ FlushFileBuffers(GetStdHandle(STD_ERROR_HANDLE));
+ } else {
+ MessageBox(NULL, msg, title, MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
+ | MB_SETFOREGROUND | MB_TOPMOST);
+ }
}
+
+
diff --git a/tk/win/tkWinInt.h b/tk/win/tkWinInt.h
index 853709861d3..37f5dda2079 100644
--- a/tk/win/tkWinInt.h
+++ b/tk/win/tkWinInt.h
@@ -5,7 +5,8 @@
* Windows-specific parts of Tk, but aren't used by the rest of
* Tk.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * 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.
@@ -28,6 +29,11 @@
#include "tkWin.h"
#endif
+#ifndef _TKPORT
+#include "tkPort.h"
+#endif
+
+
/*
* Define constants missing from older Win32 SDK header files.
*/
@@ -36,12 +42,6 @@
#define WS_EX_TOOLWINDOW 0x00000080L
#endif
-#ifndef __GNUC__
-/* gcc won't let us do this--it causes a conflict with the typedef in
- tkFont.h (as it should). */
-typedef struct TkFontAttributes TkFontAttributes;
-#endif
-
/*
* The TkWinDCState is used to save the state of a device context
* so that it can be restored later.
@@ -49,6 +49,7 @@ typedef struct TkFontAttributes TkFontAttributes;
typedef struct TkWinDCState {
HPALETTE palette;
+ int bkmode;
} TkWinDCState;
/*
@@ -90,11 +91,11 @@ typedef union {
* 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)
+#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.
@@ -125,13 +126,6 @@ typedef struct {
#define TK_WIN_CHILD_CLASS_NAME "TkChild"
/*
- * The following variable indicates whether we are restricted to Win32s
- * GDI calls.
- */
-
-extern int tkpIsWin32s;
-
-/*
* The following variable is a translation table between X gc functions and
* Win32 raster op modes.
*/
@@ -150,53 +144,29 @@ extern int tkpWinRopModes[];
* Internal procedures used by more than one source file.
*/
-extern LRESULT CALLBACK TkWinChildProc _ANSI_ARGS_((HWND hwnd, UINT message,
+#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));
-extern void TkWinClipboardRender _ANSI_ARGS_((TkDisplay *dispPtr,
- UINT format));
-extern LRESULT TkWinEmbeddedEventProc _ANSI_ARGS_((HWND hwnd,
- UINT message, WPARAM wParam, LPARAM lParam));
-extern void TkWinFillRect _ANSI_ARGS_((HDC dc, int x, int y,
- int width, int height, int pixel));
-extern COLORREF TkWinGetBorderPixels _ANSI_ARGS_((Tk_Window tkwin,
- Tk_3DBorder border, int which));
-extern HDC TkWinGetDrawableDC _ANSI_ARGS_((Display *display,
- Drawable d, TkWinDCState* state));
-extern int TkWinGetModifierState _ANSI_ARGS_((void));
-extern HPALETTE TkWinGetSystemPalette _ANSI_ARGS_((void));
-extern HWND TkWinGetWrapperWindow _ANSI_ARGS_((Tk_Window tkwin));
-extern int TkWinHandleMenuEvent _ANSI_ARGS_((HWND *phwnd,
- UINT *pMessage, WPARAM *pwParam, LPARAM *plParam,
- LRESULT *plResult));
-extern int TkWinIndexOfColor _ANSI_ARGS_((XColor *colorPtr));
-extern void TkWinPointerDeadWindow _ANSI_ARGS_((TkWindow *winPtr));
-extern void TkWinPointerEvent _ANSI_ARGS_((HWND hwnd, int x,
- int y));
-extern void TkWinPointerInit _ANSI_ARGS_((void));
-extern LRESULT TkWinReflectMessage _ANSI_ARGS_((HWND hwnd,
- UINT message, WPARAM wParam, LPARAM lParam));
-extern void TkWinReleaseDrawableDC _ANSI_ARGS_((Drawable d,
- HDC hdc, TkWinDCState* state));
-extern LRESULT TkWinResendEvent _ANSI_ARGS_((WNDPROC wndproc,
- HWND hwnd, XEvent *eventPtr));
-extern HPALETTE TkWinSelectPalette _ANSI_ARGS_((HDC dc,
- Colormap colormap));
-extern void TkWinSetMenu _ANSI_ARGS_((Tk_Window tkwin,
- HMENU hMenu));
-extern void TkWinSetWindowPos _ANSI_ARGS_((HWND hwnd,
- HWND siblingHwnd, int pos));
-extern void TkWinUpdateCursor _ANSI_ARGS_((TkWindow *winPtr));
-extern void TkWinWmCleanup _ANSI_ARGS_((HINSTANCE hInstance));
-extern HWND TkWinWmFindEmbedAssociation _ANSI_ARGS_((
- TkWindow *winPtr));
-extern void TkWinWmStoreEmbedAssociation _ANSI_ARGS_((
- TkWindow *winPtr, HWND hwnd));
-extern void TkWinXCleanup _ANSI_ARGS_((HINSTANCE hInstance));
-extern void TkWinXInit _ANSI_ARGS_((HINSTANCE hInstance));
-
-/* CYGNUS LOCAL. */
-extern void TkWinNCMetricsChanged _ANSI_ARGS_((Tk_Window tkwin));
-extern void TkWinSysColorChange _ANSI_ARGS_((void));
+
+/*
+ * Special proc needed as tsd accessor function between
+ * tkWinX.c:GenerateXEvent and tkWinClipboard.c:UpdateClipboard
+ */
+EXTERN void TkWinUpdatingClipboard(int mode);
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TKWININT */
+
diff --git a/tk/win/tkWinKey.c b/tk/win/tkWinKey.c
index 02d984e8119..c60d1bfa1cb 100644
--- a/tk/win/tkWinKey.c
+++ b/tk/win/tkWinKey.c
@@ -1,4 +1,4 @@
-/*
+/*
* tkWinKey.c --
*
* This file contains X emulation routines for keyboard related
@@ -13,158 +13,103 @@
*/
#include "tkWinInt.h"
-
-/*
- * FIXME - these are in i386-cygwin32/includes/Windows32/Defines.h
- * but not in the current Progressive release...
+/*
+ * 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.
*/
-
-#ifdef __CYGWIN32__
-#define VK_LWIN (91)
-#define VK_RWIN (92)
-#define VK_APPS (93)
-#endif
-
-typedef struct {
- unsigned int keycode;
- KeySym keysym;
-} Keys;
-
-static Keys keymap[] = {
- VK_CANCEL, XK_Cancel,
- VK_BACK, XK_BackSpace,
- VK_TAB, XK_Tab,
- VK_CLEAR, XK_Clear,
- VK_RETURN, XK_Return,
- VK_SHIFT, XK_Shift_L,
- VK_CONTROL, XK_Control_L,
- VK_MENU, XK_Alt_L,
- VK_PAUSE, XK_Pause,
- VK_CAPITAL, XK_Caps_Lock,
- VK_ESCAPE, XK_Escape,
- VK_SPACE, XK_space,
- VK_PRIOR, XK_Prior,
- VK_NEXT, XK_Next,
- VK_END, XK_End,
- VK_HOME, XK_Home,
- VK_LEFT, XK_Left,
- VK_UP, XK_Up,
- VK_RIGHT, XK_Right,
- VK_DOWN, XK_Down,
- VK_SELECT, XK_Select,
- VK_PRINT, XK_Print,
- VK_EXECUTE, XK_Execute,
- VK_INSERT, XK_Insert,
- VK_DELETE, XK_Delete,
- VK_HELP, XK_Help,
- VK_F1, XK_F1,
- VK_F2, XK_F2,
- VK_F3, XK_F3,
- VK_F4, XK_F4,
- VK_F5, XK_F5,
- VK_F6, XK_F6,
- VK_F7, XK_F7,
- VK_F8, XK_F8,
- VK_F9, XK_F9,
- VK_F10, XK_F10,
- VK_F11, XK_F11,
- VK_F12, XK_F12,
- VK_F13, XK_F13,
- VK_F14, XK_F14,
- VK_F15, XK_F15,
- VK_F16, XK_F16,
- VK_F17, XK_F17,
- VK_F18, XK_F18,
- VK_F19, XK_F19,
- VK_F20, XK_F20,
- VK_F21, XK_F21,
- VK_F22, XK_F22,
- VK_F23, XK_F23,
- VK_F24, XK_F24,
- VK_NUMLOCK, XK_Num_Lock,
- VK_SCROLL, XK_Scroll_Lock,
-
- /*
- * The following support the new keys in the Microsoft keyboard.
- * Win_L and Win_R have the windows logo. App has the menu.
- */
-
- VK_LWIN, XK_Win_L,
- VK_RWIN, XK_Win_R,
- VK_APPS, XK_App,
-
- 0, NoSymbol
+#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));
/*
*----------------------------------------------------------------------
*
- * XLookupString --
+ * TkpGetString --
*
- * Retrieve the string equivalent for the given keyboard event.
+ * Retrieve the UTF string equivalent for the given keyboard event.
*
* Results:
- * Returns the number of characters stored in buffer_return.
+ * Returns the UTF string.
*
* Side effects:
- * Retrieves the characters stored in the event and inserts them
- * into buffer_return.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-XLookupString(event_struct, buffer_return, bytes_buffer, keysym_return,
- status_in_out)
- XKeyEvent* event_struct;
- char* buffer_return;
- int bytes_buffer;
- KeySym* keysym_return;
- XComposeStatus* status_in_out;
+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 i, limit;
+ KeySym keysym;
+ XKeyEvent* keyEv = &eventPtr->xkey;
- if (event_struct->send_event != -1) {
+ Tcl_DStringInit(dsPtr);
+ if (eventPtr->xkey.send_event != -1) {
/*
* This is an event generated from generic code. It has no
* nchars or trans_chars members.
*/
- int index;
- KeySym keysym;
-
- index = 0;
- if (event_struct->state & ShiftMask) {
- index |= 1;
- }
- if (event_struct->state & Mod1Mask) {
- index |= 2;
- }
- keysym = XKeycodeToKeysym(event_struct->display,
- event_struct->keycode, index);
+ keysym = KeycodeToKeysym(eventPtr->xkey.keycode,
+ eventPtr->xkey.state, 0);
if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
|| (keysym == XK_Return)
|| (keysym == XK_Tab)) {
- buffer_return[0] = (char) keysym;
- return 1;
+ char buf[TCL_UTF_MAX];
+ int len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf);
+ Tcl_DStringAppend(dsPtr, buf, len);
}
- return 0;
- }
- if ((event_struct->nchars <= 0) || (buffer_return == NULL)) {
- return 0;
+ } else if (eventPtr->xkey.nbytes > 0) {
+ Tcl_ExternalToUtfDString(NULL, eventPtr->xkey.trans_chars,
+ eventPtr->xkey.nbytes, dsPtr);
}
- limit = (event_struct->nchars < bytes_buffer) ? event_struct->nchars :
- bytes_buffer;
-
- for (i = 0; i < limit; i++) {
- buffer_return[i] = event_struct->trans_chars[i];
- }
-
- if (keysym_return != NULL) {
- *keysym_return = NoSymbol;
- }
- return i;
+ return Tcl_DStringValue(dsPtr);
}
/*
@@ -190,41 +135,444 @@ XKeycodeToKeysym(display, keycode, index)
unsigned int keycode;
int index;
{
- Keys* key;
+ 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;
+ 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 (index & 0x02) {
+ 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 (index & 0x01) {
- keys[VK_SHIFT] = 0x80;
+ 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;
}
- result = ToAscii(keycode, scancode, keys, (LPWORD) buf, 0);
/*
* Keycode mapped to a valid Latin-1 character. Since the keysyms
* for alphanumeric characters map onto Latin-1, we just return it.
+ *
+ * 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 && buf[0] >= 0x20) {
- return (KeySym) buf[0];
+ 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.
*/
- for (key = keymap; key->keycode != 0; key++) {
- if (key->keycode == keycode) {
- return key->keysym;
+ 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];
+}
+
- return NoSymbol;
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ }
+ }
+ {
+ /* Debug log */
+ FILE *fp = fopen("c:\\temp\\tklog.txt", "a");
+ if (fp != NULL) {
+ fprintf(fp, "TkpSetKeycode. Keycode %d State %d Keysym %d\n", eventPtr->xkey.keycode, eventPtr->xkey.state, keySym);
+ fclose(fp);
+ }
+ }
}
/*
@@ -248,9 +596,23 @@ XKeysymToKeycode(display, keysym)
Display* display;
KeySym keysym;
{
- Keys* key;
+ 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) {
@@ -258,16 +620,6 @@ XKeysymToKeycode(display, keysym)
}
}
- /*
- * Couldn't map the character to a virtual keycode, so do a
- * table lookup.
- */
-
- for (key = keymap; key->keycode != 0; key++) {
- if (key->keysym == keysym) {
- return key->keycode;
- }
- }
return 0;
}
diff --git a/tk/win/tkWinMenu.c b/tk/win/tkWinMenu.c
index 8baefb25bdc..52a4aca8ea0 100644
--- a/tk/win/tkWinMenu.c
+++ b/tk/win/tkWinMenu.c
@@ -3,7 +3,8 @@
*
* This module implements the Windows platform-specific features of menus.
*
- * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * 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.
@@ -12,9 +13,10 @@
*/
#define OEMRESOURCE
-#include <string.h>
-#include "tkMenu.h"
#include "tkWinInt.h"
+#include "tkMenu.h"
+
+#include <string.h>
/*
* The class of the window for popup menus.
@@ -50,35 +52,36 @@ static int indicatorDimensions[2];
/* The dimensions of the indicator space
* in a menu entry. Calculated at init
* time to save time. */
-static Tcl_HashTable commandTable;
+
+typedef struct ThreadSpecificData {
+ Tcl_HashTable commandTable;
/* A map of command ids to menu entries */
-static int inPostMenu; /* We cannot be re-entrant like X Windows. */
-static WORD lastCommandID; /* The last command ID we allocated. */
-static HWND menuHWND; /* A window to service popup-menu messages
+ 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. */
-static int oldServiceMode; /* Used while processing a menu; we need
+ int oldServiceMode; /* Used while processing a menu; we need
* to set the event mode specially when we
* enter the menu processing modal loop
* and reset it when menus go away. */
-static TkMenu *modalMenuPtr; /* The menu we are processing inside the modal
+ TkMenu *modalMenuPtr; /* The menu we are processing inside the modal
* loop. We need this to reset all of the
* active items when menus go away since
* Windows does not see fit to give this
* to us when it sends its WM_MENUSELECT. */
-static OSVERSIONINFO versionInfo;
- /* So we don't have to keep doing this */
-static Tcl_HashTable winMenuTable;
+ Tcl_HashTable winMenuTable;
/* Need this to map HMENUs back to menuPtrs */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* The following are default menu value strings.
*/
-static char borderString[5]; /* The string indicating how big the border is */
+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:
*/
@@ -122,7 +125,7 @@ static void DrawWindowsSystemBitmap _ANSI_ARGS_((
GC gc, CONST RECT *rectPtr, int bitmapID,
int alignFlags));
static void FreeID _ANSI_ARGS_((int commandID));
-static char * GetEntryText _ANSI_ARGS_((TkMenuEntry *mePtr));
+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,
@@ -144,7 +147,6 @@ static void GetTearoffEntryGeometry _ANSI_ARGS_((TkMenu *menuPtr,
int *heightPtr));
static int GetNewID _ANSI_ARGS_((TkMenuEntry *mePtr,
int *menuIDPtr));
-static void MenuExitProc _ANSI_ARGS_((ClientData clientData));
static int MenuKeyBindProc _ANSI_ARGS_((
ClientData clientData,
Tcl_Interp *interp, XEvent *eventPtr,
@@ -154,6 +156,7 @@ 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));
@@ -189,16 +192,18 @@ GetNewID(mePtr, menuIDPtr)
int newEntry;
Tcl_HashEntry *commandEntryPtr;
WORD returnID;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- WORD curID = lastCommandID + 1;
+ WORD curID = tsdPtr->lastCommandID + 1;
/*
* The following code relies on WORD wrapping when the highest value is
* incremented.
*/
- while (curID != lastCommandID) {
- commandEntryPtr = Tcl_CreateHashEntry(&commandTable,
+ while (curID != tsdPtr->lastCommandID) {
+ commandEntryPtr = Tcl_CreateHashEntry(&tsdPtr->commandTable,
(char *) curID, &newEntry);
if (newEntry == 1) {
found = 1;
@@ -211,7 +216,7 @@ GetNewID(mePtr, menuIDPtr)
if (found) {
Tcl_SetHashValue(commandEntryPtr, (char *) mePtr);
*menuIDPtr = (int) returnID;
- lastCommandID = returnID;
+ tsdPtr->lastCommandID = returnID;
return TCL_OK;
} else {
return TCL_ERROR;
@@ -238,7 +243,10 @@ static void
FreeID(commandID)
int commandID;
{
- Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&commandTable,
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
(char *) commandID);
if (entryPtr != NULL) {
@@ -272,6 +280,8 @@ TkpNewMenu(menuPtr)
HMENU winMenuHdl;
Tcl_HashEntry *hashEntryPtr;
int newEntry;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
winMenuHdl = CreatePopupMenu();
@@ -286,7 +296,7 @@ TkpNewMenu(menuPtr)
* back when dispatch messages.
*/
- hashEntryPtr = Tcl_CreateHashEntry(&winMenuTable, (char *) winMenuHdl,
+ hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable, (char *) winMenuHdl,
&newEntry);
Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
@@ -315,6 +325,9 @@ 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);
@@ -339,7 +352,8 @@ TkpDestroyMenu(menuPtr)
for (searchEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
searchEntryPtr != NULL;
searchEntryPtr = searchEntryPtr->nextCascadePtr) {
- if (strcmp(searchEntryPtr->name, menuName) == 0) {
+ searchName = Tcl_GetStringFromObj(searchEntryPtr->namePtr, NULL);
+ if (strcmp(searchName, menuName) == 0) {
Tk_Window parentTopLevelPtr = searchEntryPtr
->menuPtr->parentTopLevelPtr;
@@ -357,7 +371,8 @@ TkpDestroyMenu(menuPtr)
* Remove the menu from the menu hash table, then destroy the handle.
*/
- hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) winMenuHdl);
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) winMenuHdl);
if (hashEntryPtr != NULL) {
Tcl_DeleteHashEntry(hashEntryPtr);
}
@@ -365,8 +380,8 @@ TkpDestroyMenu(menuPtr)
}
menuPtr->platformData = NULL;
- if (menuPtr == modalMenuPtr) {
- modalMenuPtr = NULL;
+ if (menuPtr == tsdPtr->modalMenuPtr) {
+ tsdPtr->modalMenuPtr = NULL;
}
}
@@ -431,18 +446,23 @@ GetEntryText(mePtr)
if (mePtr->type == TEAROFF_ENTRY) {
itemText = ckalloc(sizeof("(Tear-off)"));
strcpy(itemText, "(Tear-off)");
- } else if (mePtr->imageString != NULL) {
+ } else if (mePtr->imagePtr != NULL) {
itemText = ckalloc(sizeof("(Image)"));
strcpy(itemText, "(Image)");
- } else if (mePtr->bitmap != None) {
+ } else if (mePtr->bitmapPtr != NULL) {
itemText = ckalloc(sizeof("(Pixmap)"));
strcpy(itemText, "(Pixmap)");
- } else if (mePtr->label == NULL || mePtr->labelLength == 0) {
+ } else if (mePtr->labelPtr == NULL || mePtr->labelLength == 0) {
itemText = ckalloc(sizeof("( )"));
strcpy(itemText, "( )");
} else {
- int size = mePtr->labelLength + 1;
- int i, j;
+ int i;
+ char *label = (mePtr->labelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ char *accel = (mePtr->accelPtr == NULL) ? ""
+ : Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ char *p, *next;
+ Tcl_DString itemString;
/*
* We have to construct the string with an ampersand
@@ -451,57 +471,32 @@ GetEntryText(mePtr)
* ampersands in the string.
*/
- for (i = 0; i < mePtr->labelLength; i++) {
- if (mePtr->label[i] == '&') {
- size++;
- }
- }
+ Tcl_DStringInit(&itemString);
- if (mePtr->underline >= 0) {
- size++;
- if (mePtr->label[mePtr->underline] == '&') {
- size++;
+ for (p = label, i = 0; *p != '\0'; i++, p = next) {
+ if (i == mePtr->underline) {
+ Tcl_DStringAppend(&itemString, "&", 1);
}
- }
-
- if (mePtr->accelLength > 0) {
- size += mePtr->accelLength + 1;
- }
-
- for (i = 0; i < mePtr->accelLength; i++) {
- if (mePtr->accel[i] == '&') {
- size++;
+ if (*p == '&') {
+ Tcl_DStringAppend(&itemString, "&", 1);
}
+ next = Tcl_UtfNext(p);
+ Tcl_DStringAppend(&itemString, p, next - p);
}
-
- itemText = ckalloc(size);
-
- if (mePtr->labelLength == 0) {
- itemText[0] = 0;
- } else {
- for (i = 0, j = 0; i < mePtr->labelLength; i++, j++) {
- if (mePtr->label[i] == '&') {
- itemText[j++] = '&';
- }
- if (i == mePtr->underline) {
- itemText[j++] = '&';
+ 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);
}
- itemText[j] = mePtr->label[i];
+ next = Tcl_UtfNext(p);
+ Tcl_DStringAppend(&itemString, p, next - p);
}
- itemText[j] = '\0';
- }
+ }
- if (mePtr->accelLength > 0) {
- strcat(itemText, "\t");
- for (i = 0, j = strlen(itemText); i < mePtr->accelLength;
- i++, j++) {
- if (mePtr->accel[i] == '&') {
- itemText[j++] = '&';
- }
- itemText[j] = mePtr->accel[i];
- }
- itemText[j] = '\0';
- }
+ itemText = ckalloc(Tcl_DStringLength(&itemString) + 1);
+ strcpy(itemText, Tcl_DStringValue(&itemString));
+ Tcl_DStringFree(&itemString);
}
return itemText;
}
@@ -530,13 +525,14 @@ ReconfigureWindowsMenu(
TkMenu *menuPtr = (TkMenu *) clientData;
TkMenuEntry *mePtr;
HMENU winMenuHdl = (HMENU) menuPtr->platformData;
- char *itemText = NULL;
- LPCTSTR lpNewItem;
+ 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;
}
@@ -565,105 +561,117 @@ ReconfigureWindowsMenu(
lpNewItem = NULL;
flags = MF_BYPOSITION;
itemID = 0;
+ Tcl_DStringInit(&translatedText);
if ((menuPtr->menuType == MENUBAR) && (mePtr->type == TEAROFF_ENTRY)) {
continue;
}
- if (mePtr->type == SEPARATOR_ENTRY) {
- flags |= MF_SEPARATOR;
+ itemText = GetEntryText(mePtr);
+ if ((menuPtr->menuType == MENUBAR)
+ || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {
+ Tcl_UtfToExternalDString(NULL, itemText, -1, &translatedText);
+ lpNewItem = Tcl_DStringValue(&translatedText);
} else {
- itemText = GetEntryText(mePtr);
- if ((menuPtr->menuType == MENUBAR)
- || (menuPtr->menuFlags & MENU_SYSTEM_MENU)) {
- lpNewItem = itemText;
- } else {
- lpNewItem = (LPCTSTR) mePtr;
- flags |= MF_OWNERDRAW;
- }
-
- /*
- * Set enabling and disabling correctly.
- */
+ lpNewItem = (LPCTSTR) mePtr;
+ flags |= MF_OWNERDRAW;
+ }
- if (mePtr->state == tkDisabledUid) {
- flags |= MF_DISABLED;
- }
-
- /*
- * Set the check mark for check entries and radio entries.
- */
-
- if (((mePtr->type == CHECK_BUTTON_ENTRY)
- || (mePtr->type == RADIO_BUTTON_ENTRY))
- && (mePtr->entryFlags & ENTRY_SELECTED)) {
- flags |= MF_CHECKED;
- }
+ /*
+ * 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->columnBreak) {
- flags |= MF_MENUBREAK;
+ 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;
}
-
- itemID = (int) mePtr->platformEntryData;
- if ((mePtr->type == CASCADE_ENTRY)
- && (mePtr->childMenuRefPtr != NULL)
- && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
- HMENU childMenuHdl = (HMENU) mePtr->childMenuRefPtr->menuPtr
- ->platformData;
- if (childMenuHdl != NULL) {
- itemID = (UINT) childMenuHdl;
- flags |= MF_POPUP;
- }
- if ((menuPtr->menuType == MENUBAR)
- && !(mePtr->childMenuRefPtr->menuPtr->menuFlags
- & MENU_SYSTEM_MENU)) {
- TkMenuReferences *menuRefPtr;
- TkMenu *systemMenuPtr = mePtr->childMenuRefPtr
- ->menuPtr;
- char *systemMenuName = ckalloc(strlen(
- Tk_PathName(menuPtr->masterMenuPtr->tkwin))
- + strlen(".system") + 1);
-
- strcpy(systemMenuName,
- Tk_PathName(menuPtr->masterMenuPtr->tkwin));
- strcat(systemMenuName, ".system");
- menuRefPtr = TkFindMenuReferences(menuPtr->interp,
- systemMenuName);
- if ((menuRefPtr != NULL)
- && (menuRefPtr->menuPtr != NULL)
- && (menuPtr->parentTopLevelPtr != NULL)
- && (systemMenuPtr->masterMenuPtr
- == menuRefPtr->menuPtr)) {
- HMENU systemMenuHdl =
- (HMENU) systemMenuPtr->platformData;
- HWND wrapper = TkWinGetWrapperWindow(menuPtr
- ->parentTopLevelPtr);
- if (wrapper != NULL) {
- DestroyMenu(systemMenuHdl);
- systemMenuHdl = GetSystemMenu(wrapper, FALSE);
- systemMenuPtr->menuFlags |= MENU_SYSTEM_MENU;
- systemMenuPtr->platformData =
- (TkMenuPlatformData) systemMenuHdl;
- if (!(systemMenuPtr->menuFlags
- & MENU_RECONFIGURE_PENDING)) {
- systemMenuPtr->menuFlags
- |= MENU_RECONFIGURE_PENDING;
- Tcl_DoWhenIdle(ReconfigureWindowsMenu,
- (ClientData) systemMenuPtr);
- }
+ 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);
}
}
- ckfree(systemMenuName);
- }
- if (mePtr->childMenuRefPtr->menuPtr->menuFlags
- & MENU_SYSTEM_MENU) {
- systemMenu++;
}
}
+ 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;
@@ -709,8 +717,10 @@ TkpPostMenu(interp, menuPtr, x, y)
POINT point;
Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin);
int oldServiceMode = Tcl_GetServiceMode();
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- inPostMenu++;
+ tsdPtr->inPostMenu++;
if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
Tcl_CancelIdleCall(ReconfigureWindowsMenu, (ClientData) menuPtr);
@@ -719,7 +729,7 @@ TkpPostMenu(interp, menuPtr, x, y)
result = TkPreprocessMenu(menuPtr);
if (result != TCL_OK) {
- inPostMenu--;
+ tsdPtr->inPostMenu--;
return result;
}
@@ -729,7 +739,7 @@ TkpPostMenu(interp, menuPtr, x, y)
*/
if (menuPtr->tkwin == NULL) {
- inPostMenu--;
+ tsdPtr->inPostMenu--;
return TCL_OK;
}
@@ -770,14 +780,14 @@ TkpPostMenu(interp, menuPtr, x, y)
}
TrackPopupMenu(winMenuHdl, flags, x, y, 0,
- menuHWND, &noGoawayRect);
+ tsdPtr->menuHWND, &noGoawayRect);
Tcl_SetServiceMode(oldServiceMode);
GetCursorPos(&point);
Tk_PointerEvent(NULL, point.x, point.y);
- if (inPostMenu) {
- inPostMenu = 0;
+ if (tsdPtr->inPostMenu) {
+ tsdPtr->inPostMenu = 0;
}
return TCL_OK;
}
@@ -886,24 +896,27 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
int returnResult = 0;
TkMenu *menuPtr;
TkMenuEntry *mePtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
switch (*pMessage) {
case WM_INITMENU:
TkMenuInit();
- hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) *pwParam);
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) *pwParam);
if (hashEntryPtr != NULL) {
- oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ tsdPtr->oldServiceMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
- modalMenuPtr = menuPtr;
+ tsdPtr->modalMenuPtr = menuPtr;
if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
Tcl_CancelIdleCall(ReconfigureWindowsMenu,
(ClientData) menuPtr);
ReconfigureWindowsMenu((ClientData) menuPtr);
}
- if (!inPostMenu) {
+ if (!tsdPtr->inPostMenu) {
Tcl_Interp *interp;
int code;
-
+
interp = menuPtr->interp;
Tcl_Preserve((ClientData)interp);
code = TkPreprocessMenu(menuPtr);
@@ -918,20 +931,17 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
*plResult = 0;
returnResult = 1;
} else {
- modalMenuPtr = NULL;
+ tsdPtr->modalMenuPtr = NULL;
}
break;
-#if 0
- /* CYGNUS LOCAL: WM_SYSCOMMAND is not the same as WM_COMMAND. */
case WM_SYSCOMMAND:
-#endif
case WM_COMMAND: {
TkMenuInit();
if (HIWORD(*pwParam) != 0) {
break;
}
- hashEntryPtr = Tcl_FindHashEntry(&commandTable,
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->commandTable,
(char *)LOWORD(*pwParam));
if (hashEntryPtr == NULL) {
break;
@@ -952,21 +962,23 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
menuPtr = mePtr->menuPtr;
menuRefPtr = TkFindMenuReferences(menuPtr->interp,
Tk_PathName(menuPtr->tkwin));
- if ((menuRefPtr != NULL) && (menuRefPtr->parentEntryPtr
- != NULL)) {
- for (parentEntryPtr = menuRefPtr->parentEntryPtr;
- strcmp(parentEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) != 0;
- parentEntryPtr = parentEntryPtr->nextCascadePtr) {
-
- /*
- * Empty loop body.
- */
+ if ((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
- != tkDisabledUid) {
+ if (parentEntryPtr->menuPtr->entries[parentEntryPtr->index]
+ ->state != ENTRY_DISABLED) {
TkActivateMenuEntry(parentEntryPtr->menuPtr,
parentEntryPtr->index);
}
@@ -975,8 +987,8 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
interp = menuPtr->interp;
Tcl_Preserve((ClientData)interp);
code = TkInvokeMenu(interp, menuPtr, mePtr->index);
- if ((code != TCL_OK) && (code != TCL_CONTINUE)
- && (code != TCL_BREAK)) {
+ if (code != TCL_OK && code != TCL_CONTINUE
+ && code != TCL_BREAK) {
Tcl_AddErrorInfo(interp, "\n (menu invoke)");
Tcl_BackgroundError(interp);
}
@@ -990,19 +1002,27 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
case WM_MENUCHAR: {
unsigned char menuChar = (unsigned char) LOWORD(*pwParam);
- hashEntryPtr = Tcl_FindHashEntry(&winMenuTable, (char *) *plParam);
+ 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 = menuPtr->entries[i]->underline;
+ 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]->label)
+ && (NULL != menuPtr->entries[i]->labelPtr)
&& (CharUpper((LPTSTR) menuChar)
- == CharUpper((LPTSTR) (unsigned char) menuPtr
- ->entries[i]->label[underline]))) {
+ == CharUpper((LPTSTR) (unsigned char)
+ label[underline]))) {
*plResult = (2 << 16) | i;
returnResult = 1;
break;
@@ -1025,7 +1045,12 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
if (mePtr->hideMargin) {
itemPtr->itemWidth += 2 - indicatorDimensions[1];
} else {
- itemPtr->itemWidth += 2 * menuPtr->activeBorderWidth;
+ int activeBorderWidth;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr,
+ &activeBorderWidth);
+ itemPtr->itemWidth += 2 * activeBorderWidth;
}
*plResult = 1;
returnResult = 1;
@@ -1039,13 +1064,15 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
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 != tkDisabledUid) {
+ if (mePtr->state != ENTRY_DISABLED) {
if (itemPtr->itemState & ODS_SELECTED) {
TkActivateMenuEntry(menuPtr, mePtr->index);
} else {
@@ -1053,8 +1080,9 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
}
}
- Tk_GetFontMetrics(menuPtr->tkfont, &fontMetrics);
- TkpDrawMenuEntry(mePtr, (Drawable) twdPtr, menuPtr->tkfont,
+ 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
@@ -1073,14 +1101,14 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
TkMenuInit();
if ((flags == 0xFFFF) && (*plParam == 0)) {
- Tcl_SetServiceMode(oldServiceMode);
- if (modalMenuPtr != NULL) {
- RecursivelyClearActiveMenu(modalMenuPtr);
+ Tcl_SetServiceMode(tsdPtr->oldServiceMode);
+ if (tsdPtr->modalMenuPtr != NULL) {
+ RecursivelyClearActiveMenu(tsdPtr->modalMenuPtr);
}
} else {
menuPtr = NULL;
- if (*plParam != 0) {
- hashEntryPtr = Tcl_FindHashEntry(&winMenuTable,
+ if (*plParam != 0) {
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
(char *) *plParam);
if (hashEntryPtr != NULL) {
menuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
@@ -1093,15 +1121,17 @@ TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
if (flags & MF_POPUP) {
mePtr = menuPtr->entries[LOWORD(*pwParam)];
} else {
- hashEntryPtr = Tcl_FindHashEntry(&commandTable,
+ hashEntryPtr = Tcl_FindHashEntry(
+ &tsdPtr->commandTable,
(char *) LOWORD(*pwParam));
if (hashEntryPtr != NULL) {
- mePtr = (TkMenuEntry *) Tcl_GetHashValue(hashEntryPtr);
+ mePtr = (TkMenuEntry *)
+ Tcl_GetHashValue(hashEntryPtr);
}
}
}
- if ((mePtr == NULL) || (mePtr->state == tkDisabledUid)) {
+ if ((mePtr == NULL) || (mePtr->state == ENTRY_DISABLED)) {
TkActivateMenuEntry(menuPtr, -1);
} else {
TkActivateMenuEntry(menuPtr, mePtr->index);
@@ -1174,18 +1204,21 @@ TkpSetWindowMenuBar(tkwin, menuPtr)
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(&winMenuTable, (char *) winMenuHdl);
+ hashEntryPtr = Tcl_FindHashEntry(&tsdPtr->winMenuTable,
+ (char *) winMenuHdl);
Tcl_DeleteHashEntry(hashEntryPtr);
DestroyMenu(winMenuHdl);
winMenuHdl = CreateMenu();
- hashEntryPtr = Tcl_CreateHashEntry(&winMenuTable, (char *) winMenuHdl,
- &newEntry);
+ hashEntryPtr = Tcl_CreateHashEntry(&tsdPtr->winMenuTable,
+ (char *) winMenuHdl, &newEntry);
Tcl_SetHashValue(hashEntryPtr, (char *) menuPtr);
menuPtr->platformData = (TkMenuPlatformData) winMenuHdl;
TkWinSetMenu(tkwin, winMenuHdl);
@@ -1257,7 +1290,11 @@ GetMenuIndicatorGeometry (
if (mePtr->hideMargin) {
*widthPtr = 0;
} else {
- *widthPtr = indicatorDimensions[1] - menuPtr->borderWidth;
+ int borderWidth;
+
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ *widthPtr = indicatorDimensions[1] - borderWidth;
}
}
@@ -1289,10 +1326,11 @@ GetMenuAccelGeometry (
*heightPtr = fmPtr->linespace;
if (mePtr->type == CASCADE_ENTRY) {
*widthPtr = 0;
- } else if (mePtr->accel == NULL) {
+ } else if (mePtr->accelPtr == NULL) {
*widthPtr = 0;
} else {
- *widthPtr = Tk_TextWidth(tkfont, mePtr->accel, mePtr->accelLength);
+ char *accel = Tcl_GetStringFromObj(mePtr->accelPtr, NULL);
+ *widthPtr = Tk_TextWidth(tkfont, accel, mePtr->accelLength);
}
}
@@ -1355,7 +1393,7 @@ GetMenuSeparatorGeometry (
int *heightPtr) /* The resulting height */
{
*widthPtr = 0;
- *heightPtr = fmPtr->linespace;
+ *heightPtr = fmPtr->linespace - (2 * fmPtr->descent);
}
/*
@@ -1382,7 +1420,7 @@ 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 */
+ 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
@@ -1468,47 +1506,44 @@ DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr, x,
int width;
int height;
{
- if ((mePtr->type == CHECK_BUTTON_ENTRY ||
- mePtr->type == RADIO_BUTTON_ENTRY)
- && mePtr->indicatorOn
- && mePtr->entryFlags & ENTRY_SELECTED) {
- RECT rect;
- GC whichGC;
-
- if (mePtr->state != tkNormalUid) {
- whichGC = gc;
- } else {
- whichGC = indicatorGC;
- }
-
- rect.top = y;
- rect.bottom = y + mePtr->height;
- rect.left = menuPtr->borderWidth + menuPtr->activeBorderWidth + x;
- rect.right = mePtr->indicatorSpace + x;
-
- if ((mePtr->state == tkDisabledUid) && (menuPtr->disabledFg != NULL)
- && (versionInfo.dwMajorVersion >= 4)) {
- RECT hilightRect;
- COLORREF oldFgColor = whichGC->foreground;
-
- whichGC->foreground = GetSysColor(COLOR_3DHILIGHT);
- hilightRect.top = rect.top + 1;
- hilightRect.bottom = rect.bottom + 1;
- hilightRect.left = rect.left + 1;
- hilightRect.right = rect.right + 1;
- DrawWindowsSystemBitmap(menuPtr->display, d, whichGC,
- &hilightRect, OBM_CHECK, 0);
- whichGC->foreground = oldFgColor;
- }
+ 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;
+ }
- DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect,
- OBM_CHECK, 0);
+ 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;
+ }
- if ((mePtr->state == tkDisabledUid)
- && (menuPtr->disabledImageGC != None)
- && (versionInfo.dwMajorVersion < 4)) {
- XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
- rect.left, rect.top, rect.right, rect.bottom);
+ DrawWindowsSystemBitmap(menuPtr->display, d, whichGC, &rect,
+ OBM_CHECK, 0);
}
}
}
@@ -1553,48 +1588,43 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
{
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 == tkDisabledUid) && (menuPtr->disabledFg != NULL)
- && ((mePtr->accel != NULL)
- || ((mePtr->type == CASCADE_ENTRY) && drawArrow))) {
- if (versionInfo.dwMajorVersion >= 4) {
- COLORREF oldFgColor = gc->foreground;
-
- gc->foreground = GetSysColor(COLOR_3DHILIGHT);
- if (mePtr->accel != NULL) {
- Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
- mePtr->accelLength, leftEdge + 1, baseline + 1);
- }
+ if ((mePtr->state == ENTRY_DISABLED) && (menuPtr->disabledFgPtr != NULL)
+ && ((mePtr->accelPtr != NULL)
+ || ((mePtr->type == CASCADE_ENTRY) && drawArrow))) {
+ COLORREF oldFgColor = gc->foreground;
- if (mePtr->type == CASCADE_ENTRY) {
- RECT rect;
+ gc->foreground = GetSysColor(COLOR_3DHILIGHT);
+ if (mePtr->accelPtr != NULL) {
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
+ mePtr->accelLength, leftEdge + 1, baseline + 1);
+ }
- 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->type == CASCADE_ENTRY) {
+ RECT rect;
+
+ rect.top = y + GetSystemMetrics(SM_CYBORDER) + 1;
+ rect.bottom = y + height - GetSystemMetrics(SM_CYBORDER) + 1;
+ rect.left = x + mePtr->indicatorSpace + mePtr->labelWidth + 1;
+ rect.right = x + width;
+ DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect,
+ OBM_MNARROW, ALIGN_BITMAP_RIGHT);
}
+ gc->foreground = oldFgColor;
}
- if (mePtr->accel != NULL) {
- Tk_DrawChars(menuPtr->display, d, gc, tkfont, mePtr->accel,
+ if (mePtr->accelPtr != NULL) {
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, accel,
mePtr->accelLength, leftEdge, baseline);
}
- if ((mePtr->state == tkDisabledUid)
- && (menuPtr->disabledImageGC != None)
- && (versionInfo.dwMajorVersion < 4)) {
- XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
- leftEdge, y, width - mePtr->labelWidth
- - mePtr->indicatorSpace, height);
- }
-
if ((mePtr->type == CASCADE_ENTRY) && drawArrow) {
RECT rect;
@@ -1604,12 +1634,6 @@ DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
rect.right = x + width - 1;
DrawWindowsSystemBitmap(menuPtr->display, d, gc, &rect, OBM_MNARROW,
ALIGN_BITMAP_RIGHT);
- if ((mePtr->state == tkDisabledUid)
- && (menuPtr->disabledImageGC != None)
- && (versionInfo.dwMajorVersion < 4)) {
- XFillRectangle(menuPtr->display, d, menuPtr->disabledImageGC,
- rect.left, rect.top, rect.right, rect.bottom);
- }
}
}
@@ -1643,13 +1667,15 @@ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
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;
- Tk_Draw3DPolygon(menuPtr->tkwin, d,
- menuPtr->border, points, 2, 1, TK_RELIEF_RAISED);
+ border = Tk_Get3DBorderFromObj(menuPtr->tkwin, menuPtr->borderPtr);
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
+ TK_RELIEF_RAISED);
}
/*
@@ -1683,10 +1709,14 @@ DrawMenuUnderline(
int height) /* Height of entry */
{
if (mePtr->underline >= 0) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ char *start = Tcl_UtfAtIndex(label, mePtr->underline);
+ char *end = Tcl_UtfNext(start);
+
Tk_UnderlineChars(menuPtr->display, d,
- gc, tkfont, mePtr->label, x + mePtr->indicatorSpace,
+ gc, tkfont, label, x + mePtr->indicatorSpace,
y + (height + fmPtr->ascent - fmPtr->descent) / 2,
- mePtr->underline, mePtr->underline + 1);
+ start - label, end - label);
}
}
@@ -1748,8 +1778,8 @@ MenuKeyBindProc(clientData, interp, eventPtr, tkwin, keySym)
CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSKEYDOWN, virtualKey, ((scanCode << 16)
| (1 << 29)));
- if (eventPtr->xkey.nchars > 0) {
- for (i = 0; i < eventPtr->xkey.nchars; i++) {
+ if (eventPtr->xkey.nbytes > 0) {
+ for (i = 0; i < eventPtr->xkey.nbytes; i++) {
CallWindowProc(DefWindowProc,
Tk_GetHWND(Tk_WindowId(tkwin)),
WM_SYSCHAR,
@@ -1875,9 +1905,14 @@ DrawMenuEntryLabel(
{
int baseline;
int indicatorSpace = mePtr->indicatorSpace;
- int leftEdge = x + indicatorSpace + menuPtr->activeBorderWidth;
+ int activeBorderWidth;
+ int leftEdge;
int imageHeight, imageWidth;
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->activeBorderWidthPtr, &activeBorderWidth);
+ leftEdge = x + indicatorSpace + activeBorderWidth;
+
/*
* Draw label or bitmap or image for entry.
*/
@@ -1895,27 +1930,25 @@ DrawMenuEntryLabel(
imageHeight, d, leftEdge,
(int) (y + (mePtr->height - imageHeight)/2));
}
- } else if (mePtr->bitmap != None) {
+ } else if (mePtr->bitmapPtr != NULL) {
int width, height;
-
- Tk_SizeOfBitmap(menuPtr->display,
- mePtr->bitmap, &width, &height);
- XCopyPlane(menuPtr->display,
- mePtr->bitmap, d,
- gc, 0, 0, (unsigned) width, (unsigned) height, leftEdge,
- (int) (y + (mePtr->height - height)/2), 1);
+ 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) {
- Tk_DrawChars(menuPtr->display, d, gc,
- tkfont, mePtr->label, mePtr->labelLength,
- leftEdge, baseline);
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+ Tk_DrawChars(menuPtr->display, d, gc, tkfont, label,
+ mePtr->labelLength, leftEdge, baseline);
DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y,
width, height);
}
}
- if (mePtr->state == tkDisabledUid) {
- if (menuPtr->disabledFg == NULL) {
+ 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)
@@ -1986,6 +2019,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
{
XPoint points[2];
int segmentWidth, maxX;
+ Tk_3DBorder border;
if (menuPtr->menuType != MASTER_MENU) {
return;
@@ -1996,13 +2030,14 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
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, menuPtr->border, points, 2, 1,
+ Tk_Draw3DPolygon(menuPtr->tkwin, d, border, points, 2, 1,
TK_RELIEF_RAISED);
points[0].x += 2*segmentWidth;
}
@@ -2017,7 +2052,7 @@ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
*
* Results:
* Returns standard TCL result. If TCL_ERROR is returned, then
- * interp->result contains an error message.
+ * the interp's result contains an error message.
*
* Side effects:
* Configuration information get set for mePtr; old resources
@@ -2088,8 +2123,7 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
* Choose the gc for drawing the foreground part of the entry.
*/
- if ((mePtr->state == tkActiveUid)
- && !strictMotif) {
+ if ((mePtr->state == ENTRY_ACTIVE) && !strictMotif) {
gc = mePtr->activeGC;
if (gc == NULL) {
gc = menuPtr->activeGC;
@@ -2097,21 +2131,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
} else {
TkMenuEntry *cascadeEntryPtr;
int parentDisabled = 0;
+ char *name;
for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
cascadeEntryPtr != NULL;
cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
- if (strcmp(cascadeEntryPtr->name,
- Tk_PathName(menuPtr->tkwin)) == 0) {
- if (cascadeEntryPtr->state == tkDisabledUid) {
+ 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 == tkDisabledUid)))
- && (menuPtr->disabledFg != NULL)) {
+ if (((parentDisabled || (mePtr->state == ENTRY_DISABLED)))
+ && (menuPtr->disabledFgPtr != NULL)) {
gc = mePtr->disabledGC;
if (gc == NULL) {
gc = menuPtr->disabledGC;
@@ -2127,24 +2162,22 @@ TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
if (indicatorGC == NULL) {
indicatorGC = menuPtr->indicatorGC;
}
-
- bgBorder = mePtr->border;
- if (bgBorder == NULL) {
- bgBorder = menuPtr->border;
- }
+
+ bgBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->borderPtr == NULL) ? menuPtr->borderPtr
+ : mePtr->borderPtr);
if (strictMotif) {
activeBorder = bgBorder;
} else {
- activeBorder = mePtr->activeBorder;
- if (activeBorder == NULL) {
- activeBorder = menuPtr->activeBorder;
- }
+ activeBorder = Tk_Get3DBorderFromObj(menuPtr->tkwin,
+ (mePtr->activeBorderPtr == NULL) ? menuPtr->activeBorderPtr
+ : mePtr->activeBorderPtr);
}
- if (mePtr->tkfont == NULL) {
+ if (mePtr->fontPtr == NULL) {
fmPtr = menuMetricsPtr;
} else {
- tkfont = mePtr->tkfont;
+ tkfont = Tk_GetFontFromObj(menuPtr->tkwin, mePtr->fontPtr);
Tk_GetFontMetrics(tkfont, &entryMetrics);
fmPtr = &entryMetrics;
}
@@ -2207,13 +2240,16 @@ GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr)
if (mePtr->image != NULL) {
Tk_SizeOfImage(mePtr->image, widthPtr, heightPtr);
- } else if (mePtr->bitmap != (Pixmap) NULL) {
- Tk_SizeOfBitmap(menuPtr->display, mePtr->bitmap, widthPtr, heightPtr);
+ } else 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->label != NULL) {
- *widthPtr = Tk_TextWidth(tkfont, mePtr->label, mePtr->labelLength);
+ if (mePtr->labelPtr != NULL) {
+ char *label = Tcl_GetStringFromObj(mePtr->labelPtr, NULL);
+
+ *widthPtr = Tk_TextWidth(tkfont, label, mePtr->labelLength);
} else {
*widthPtr = 0;
}
@@ -2250,7 +2286,7 @@ DrawMenuEntryBackground(
int width, /* width of rectangle to draw */
int height) /* height of rectangle to draw */
{
- if (mePtr->state == tkActiveUid) {
+ if (mePtr->state == ENTRY_ACTIVE) {
bgBorder = activeBorder;
}
Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
@@ -2280,17 +2316,20 @@ void
TkpComputeStandardMenuGeometry(
TkMenu *menuPtr) /* Structure describing menu. */
{
- Tk_Font tkfont;
+ 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;
}
- x = y = menuPtr->borderWidth;
+ Tk_GetPixelsFromObj(menuPtr->interp, menuPtr->tkwin,
+ menuPtr->borderWidthPtr, &borderWidth);
+ x = y = borderWidth;
indicatorSpace = labelWidth = accelWidth = 0;
windowHeight = 0;
@@ -2305,19 +2344,22 @@ TkpComputeStandardMenuGeometry(
* give all of the geometry/drawing the entry's font and metrics.
*/
- Tk_GetFontMetrics(menuPtr->tkfont, &menuMetrics);
- accelSpace = Tk_TextWidth(menuPtr->tkfont, "M", 1);
+ 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++) {
- tkfont = menuPtr->entries[i]->tkfont;
- if (tkfont == NULL) {
- tkfont = menuPtr->tkfont;
- fmPtr = &menuMetrics;
- } else {
+ 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;
@@ -2326,15 +2368,15 @@ TkpComputeStandardMenuGeometry(
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
- + accelWidth + 2 * menuPtr->activeBorderWidth;
+ + accelWidth + 2 * activeBorderWidth;
menuPtr->entries[j]->x = x;
menuPtr->entries[j]->entryFlags &= ~ENTRY_LAST_COLUMN;
}
x += indicatorSpace + labelWidth + accelWidth
- + 2 * menuPtr->borderWidth;
+ + 2 * borderWidth;
indicatorSpace = labelWidth = accelWidth = 0;
lastColumnBreak = i;
- y = menuPtr->borderWidth;
+ y = borderWidth;
}
if (menuPtr->entries[i]->type == SEPARATOR_ENTRY) {
@@ -2382,7 +2424,7 @@ TkpComputeStandardMenuGeometry(
indicatorSpace = width;
}
- menuPtr->entries[i]->height += 2 * menuPtr->activeBorderWidth + 1;
+ menuPtr->entries[i]->height += 2 * activeBorderWidth + 1;
}
menuPtr->entries[i]->y = y;
y += menuPtr->entries[i]->height;
@@ -2398,16 +2440,15 @@ TkpComputeStandardMenuGeometry(
menuPtr->entries[j]->indicatorSpace = indicatorSpace;
menuPtr->entries[j]->labelWidth = labelWidth;
menuPtr->entries[j]->width = indicatorSpace + labelWidth
- + accelWidth + 2 * menuPtr->activeBorderWidth;
+ + accelWidth + 2 * activeBorderWidth;
menuPtr->entries[j]->x = x;
menuPtr->entries[j]->entryFlags |= ENTRY_LAST_COLUMN;
}
windowWidth = x + indicatorSpace + labelWidth + accelWidth + accelSpace
- + 2 * menuPtr->activeBorderWidth
- + 2 * menuPtr->borderWidth;
+ + 2 * activeBorderWidth + 2 * borderWidth;
- windowHeight += menuPtr->borderWidth;
+ windowHeight += borderWidth;
/*
* The X server doesn't like zero dimensions, so round up to at least
@@ -2533,14 +2574,55 @@ static void
MenuExitHandler(
ClientData clientData) /* Not used */
{
- DestroyWindow(menuHWND);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ DestroyWindow(tsdPtr->menuHWND);
UnregisterClass(MENU_CLASS_NAME, Tk_GetHINSTANCE());
}
/*
*----------------------------------------------------------------------
*
- * TkpMenuInit --
+ * TkWinGetMenuSystemDefault --
+ *
+ * Gets the Windows specific default value for a given X resource
+ * database name.
+ *
+ * Results:
+ * Returns a Tcl_Obj * with the default value. If there is no
+ * Windows-specific default for this attribute, returns NULL.
+ * This object has a ref count of 0.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TkWinGetMenuSystemDefault(
+ Tk_Window tkwin, /* A window to use. */
+ char *dbName, /* The option database name. */
+ char *className) /* The name of the option class. */
+{
+ Tcl_Obj *valuePtr = NULL;
+
+ if ((strcmp(dbName, "activeBorderWidth") == 0) ||
+ (strcmp(dbName, "borderWidth") == 0)) {
+ valuePtr = Tcl_NewIntObj(defaultBorderWidth);
+ } else if (strcmp(dbName, "font") == 0) {
+ valuePtr = Tcl_NewStringObj(Tcl_DStringValue(&menuFontDString),
+ -1);
+ }
+
+ return valuePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinMenuSetDefaults --
*
* Sets up the hash tables and the variables used by the menu package.
*
@@ -2555,123 +2637,72 @@ MenuExitHandler(
*/
void
-TkpMenuInit()
+SetDefaults(
+ int firstTime) /* Is this the first time this
+ * has been called? */
{
- WNDCLASS wndClass;
- char sizeString[4];
+ char sizeString[TCL_INTEGER_SPACE];
char faceName[LF_FACESIZE];
HDC scratchDC;
Tcl_DString boldItalicDString;
int bold = 0;
int italic = 0;
- int i;
TEXTMETRIC tm;
-
- Tcl_InitHashTable(&winMenuTable, TCL_ONE_WORD_KEYS);
- Tcl_InitHashTable(&commandTable, TCL_ONE_WORD_KEYS);
-
- wndClass.style = CS_OWNDC;
- wndClass.lpfnWndProc = TkWinMenuProc;
- wndClass.cbClsExtra = 0;
- wndClass.cbWndExtra = 0;
- wndClass.hInstance = Tk_GetHINSTANCE();
- wndClass.hIcon = NULL;
- wndClass.hCursor = NULL;
- wndClass.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);
- wndClass.lpszMenuName = NULL;
- wndClass.lpszClassName = MENU_CLASS_NAME;
- RegisterClass(&wndClass);
-
- menuHWND = CreateWindow(MENU_CLASS_NAME, "MenuWindow", WS_POPUP,
- 0, 0, 10, 10, NULL, NULL, Tk_GetHINSTANCE(), NULL);
-
- Tcl_CreateExitHandler(MenuExitHandler, (ClientData) NULL);
-
- versionInfo.dwOSVersionInfoSize = sizeof(versionInfo);
-
- /*
- * If GetVersionEx fails, it means that the version info record
- * is too big for what is compiled. Should never happen, but if
- * it does, we are later than Windows 95 or NT 4.0.
- */
-
- if (!GetVersionEx(&versionInfo)) {
- versionInfo.dwMajorVersion = 4;
- }
+ 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.
*/
- for (i = 0; ; i++) {
- if (tkMenuConfigSpecs[i].type == TK_CONFIG_END) {
- break;
- }
-
- if ((strcmp(tkMenuConfigSpecs[i].dbName,
- "activeBorderWidth") == 0) ||
- (strcmp(tkMenuConfigSpecs[i].dbName, "borderWidth") == 0)) {
- int borderWidth;
-
- borderWidth = GetSystemMetrics(SM_CXBORDER);
- if (GetSystemMetrics(SM_CYBORDER) > borderWidth) {
- borderWidth = GetSystemMetrics(SM_CYBORDER);
- }
- sprintf(borderString, "%d", borderWidth);
- tkMenuConfigSpecs[i].defValue = borderString;
- } else if ((strcmp(tkMenuConfigSpecs[i].dbName, "font") == 0)) {
- int pointSize;
- HFONT menuFont;
-
- scratchDC = CreateDC("DISPLAY", NULL, NULL, NULL);
- Tcl_DStringInit(&menuFontDString);
-
- if (versionInfo.dwMajorVersion >= 4) {
- NONCLIENTMETRICS ncMetrics;
-
- ncMetrics.cbSize = sizeof(ncMetrics);
- SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncMetrics),
- &ncMetrics, 0);
- menuFont = CreateFontIndirect(&ncMetrics.lfMenuFont);
- } else {
- menuFont = GetStockObject(SYSTEM_FONT);
- }
- SelectObject(scratchDC, menuFont);
- GetTextMetrics(scratchDC, &tm);
- GetTextFace(scratchDC, sizeof(menuFontDString), faceName);
- pointSize = MulDiv(tm.tmHeight - tm.tmInternalLeading,
- 72, GetDeviceCaps(scratchDC, LOGPIXELSY));
- if (tm.tmWeight >= 700) {
- bold = 1;
- }
- if (tm.tmItalic) {
- italic = 1;
- }
+ defaultBorderWidth = GetSystemMetrics(SM_CXBORDER);
+ if (GetSystemMetrics(SM_CYBORDER) > defaultBorderWidth) {
+ defaultBorderWidth = GetSystemMetrics(SM_CYBORDER);
+ }
- SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
- DeleteDC(scratchDC);
+ 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;
+ }
- 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));
- }
+ SelectObject(scratchDC, GetStockObject(SYSTEM_FONT));
+ DeleteDC(scratchDC);
- tkMenuConfigSpecs[i].defValue = Tcl_DStringValue(&menuFontDString);
+ 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));
}
/*
@@ -2684,7 +2715,7 @@ TkpMenuInit()
* documented.
*/
- if (versionInfo.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) {
+ if (TkWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK);
indicatorDimensions[1] = ((GetSystemMetrics(SM_CXFIXEDFRAME) +
GetSystemMetrics(SM_CXBORDER)
@@ -2695,5 +2726,72 @@ TkpMenuInit()
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/tk/win/tkWinPixmap.c b/tk/win/tkWinPixmap.c
index 7dae990623a..62b90180aee 100644
--- a/tk/win/tkWinPixmap.c
+++ b/tk/win/tkWinPixmap.c
@@ -138,7 +138,7 @@ TkSetPixmapColormap(pixmap, colormap)
*
* Retrieve the geometry of the given drawable. Note that
* this is a degenerate implementation that only returns the
- * size of a pixmap.
+ * size of a pixmap or window.
*
* Results:
* Returns 0.
@@ -163,22 +163,37 @@ XGetGeometry(display, d, root_return, x_return, y_return, width_return,
unsigned int* depth_return;
{
TkWinDrawable *twdPtr = (TkWinDrawable *)d;
- HDC dc;
- BITMAPINFO info;
- if ((twdPtr->type != TWD_BITMAP) || (twdPtr->bitmap.handle == NULL)) {
- panic("XGetGeometry: invalid pixmap");
- }
- dc = GetDC(NULL);
- info.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
- info.bmiHeader.biBitCount = 0;
- if (!GetDIBits(dc, twdPtr->bitmap.handle, 0, 0, NULL, &info,
- DIB_RGB_COLORS)) {
- panic("XGetGeometry: unable to get bitmap size");
- }
- ReleaseDC(NULL, dc);
+ 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;
- *width_return = info.bmiHeader.biWidth;
- *height_return = info.bmiHeader.biHeight;
+ 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/tk/win/tkWinPointer.c b/tk/win/tkWinPointer.c
index dd747abfc60..3ed9aa97f42 100644
--- a/tk/win/tkWinPointer.c
+++ b/tk/win/tkWinPointer.c
@@ -4,6 +4,7 @@
* 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.
@@ -62,7 +63,7 @@ TkWinGetModifierState()
state |= ControlMask;
}
if (GetKeyState(VK_MENU) & 0x8000) {
- state |= Mod2Mask;
+ state |= ALT_MASK;
}
if (GetKeyState(VK_CAPITAL) & 0x0001) {
state |= LockMask;
@@ -237,8 +238,22 @@ MouseTimerProc(clientData)
GetCursorPos(&pos);
Tk_PointerEvent(NULL, pos.x, pos.y);
}
-
-/* CYGNUS LOCAL: Cancel any current mouse timer. */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinCancelMouseTimer --
+ *
+ * If the mouse timer is set, cancel it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May cancel the mouse timer.
+ *
+ *----------------------------------------------------------------------
+ */
void
TkWinCancelMouseTimer()
@@ -316,6 +331,42 @@ XQueryPointer(display, w, root_return, child_return, root_x_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);
+}
/*
*----------------------------------------------------------------------
@@ -427,7 +478,7 @@ TkpChangeFocus(winPtr, force)
*/
if (force) {
- SetForegroundWindow(Tk_GetHWND(winPtr->window));
+ TkWinSetForegroundWindow(winPtr);
}
XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent,
CurrentTime);
diff --git a/tk/win/tkWinPort.h b/tk/win/tkWinPort.h
index 532c9d1200b..c04862bf3b3 100644
--- a/tk/win/tkWinPort.h
+++ b/tk/win/tkWinPort.h
@@ -6,7 +6,6 @@
* file that contains #ifdefs to handle different flavors of OS.
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -32,19 +31,29 @@
#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>
#ifdef _MSC_VER
+#include <tchar.h>
+#endif
+
+#ifdef _MSC_VER
# define hypot _hypot
#endif /* _MSC_VER */
-#ifdef __CYGWIN32__
-#define strnicmp strncasecmp
-#define stricmp strcasecmp
-#else
-#define strncasecmp strnicmp
-#define strcasecmp stricmp
+#ifndef __GNUC__
+# define strncasecmp strnicmp
+# define strcasecmp stricmp
#endif
#define NBBY 8
@@ -123,13 +132,11 @@ struct timezone {
int tz_dsttime;
};
+#endif
-struct timeval;
-
-extern int gettimeofday(struct timeval *, struct timezone *);
-
-#endif /* ! __MINGW32__ */
-
-EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
#endif /* _WINPORT */
+
diff --git a/tk/win/tkWinRegion.c b/tk/win/tkWinRegion.c
index 1866971864b..3f4024da24e 100644
--- a/tk/win/tkWinRegion.c
+++ b/tk/win/tkWinRegion.c
@@ -177,3 +177,4 @@ TkRectInRegion(r, x, y, width, height)
rect.right = x+width;
return RectInRegion((HRGN)r, &rect) ? RectanglePart : RectangleOut;
}
+
diff --git a/tk/win/tkWinScrlbr.c b/tk/win/tkWinScrlbr.c
index 12f4ea212eb..fa622ca365d 100644
--- a/tk/win/tkWinScrlbr.c
+++ b/tk/win/tkWinScrlbr.c
@@ -57,12 +57,14 @@ 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[8];
+static char defWidth[TCL_INTEGER_SPACE];
/*
* Declarations for functions defined in this file.
@@ -116,8 +118,10 @@ TkpCreateScrollbar(tkwin)
TkWindow *winPtr = (TkWindow *)tkwin;
if (!initialized) {
+ Tcl_MutexLock(&winScrlbrMutex);
UpdateScrollbarMetrics();
initialized = 1;
+ Tcl_MutexUnlock(&winScrlbrMutex);
}
scrollPtr = (WinScrollbar *) ckalloc(sizeof(WinScrollbar));
@@ -173,11 +177,7 @@ UpdateScrollbar(scrollPtr)
scrollInfo.nMin = 0;
scrollInfo.nMax = MAX_SCROLL;
thumbSize = (scrollPtr->info.lastFraction - scrollPtr->info.firstFraction);
- if (tkpIsWin32s) {
- scrollInfo.nPage = 0;
- } else {
- scrollInfo.nPage = ((UINT) (thumbSize * (double) MAX_SCROLL)) + 1;
- }
+ scrollInfo.nPage = ((UINT) (thumbSize * (double) MAX_SCROLL)) + 1;
if (thumbSize < 1.0) {
scrollInfo.nPos = (int)
((scrollPtr->info.firstFraction / (1.0-thumbSize))
@@ -668,16 +668,18 @@ ModalLoopProc(tkwin, eventPtr)
WinScrollbar *scrollPtr = (WinScrollbar *) winPtr->instanceData;
int oldMode;
- Tcl_Preserve((ClientData)scrollPtr);
- scrollPtr->winFlags |= IN_MODAL_LOOP;
- oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
- TkWinResendEvent(scrollPtr->oldProc, scrollPtr->hwnd, eventPtr);
- (void) Tcl_SetServiceMode(oldMode);
- scrollPtr->winFlags &= ~IN_MODAL_LOOP;
- if (scrollPtr->hwnd && scrollPtr->winFlags & ALREADY_DEAD) {
- DestroyWindow(scrollPtr->hwnd);
+ 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);
}
- Tcl_Release((ClientData)scrollPtr);
}
/*
@@ -743,3 +745,5 @@ TkpScrollbarPosition(scrollPtr, x, y)
}
return BOTTOM_GAP;
}
+
+
diff --git a/tk/win/tkWinTest.c b/tk/win/tkWinTest.c
new file mode 100644
index 00000000000..dd66ce05f46
--- /dev/null
+++ b/tk/win/tkWinTest.c
@@ -0,0 +1,250 @@
+/*
+ * tkWinTest.c --
+ *
+ * Contains commands for platform specific tests for
+ * the Windows platform.
+ *
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 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"
+
+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, 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+
+ 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);
+ return TCL_ERROR;
+ }
+ CloseClipboard();
+ } else {
+ Tcl_AppendResult(interp, "couldn't open clipboard", (char *) NULL);
+ 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. */
+ char **argv; /* Argument strings. */
+{
+ HWND hwnd;
+ int id;
+ char *rest;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+ static TkStateMap messageMap[] = {
+ {WM_LBUTTONDOWN, "WM_LBUTTONDOWN"},
+ {WM_LBUTTONUP, "WM_LBUTTONUP"},
+ {WM_CHAR, "WM_CHAR"},
+ {WM_GETTEXT, "WM_GETTEXT"},
+ {WM_SETTEXT, "WM_SETTEXT"},
+ {-1, NULL}
+ };
+
+ if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
+ int i;
+
+ if (Tcl_GetBoolean(interp, argv[2], &i) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkWinDialogDebug(i);
+ return TCL_OK;
+ }
+
+ if (argc < 4) {
+ return TCL_ERROR;
+ }
+
+ hwnd = (HWND) strtol(argv[1], &rest, 0);
+ if (rest == argv[2]) {
+ hwnd = FindWindow(NULL, argv[1]);
+ if (hwnd == NULL) {
+ Tcl_SetResult(interp, "no such window", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ }
+ UpdateWindow(hwnd);
+
+ id = strtol(argv[2], &rest, 0);
+ if (rest == argv[2]) {
+ HWND child;
+ char buf[256];
+
+ child = GetWindow(hwnd, GW_CHILD);
+ while (child != NULL) {
+ SendMessage(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
+ if (strcasecmp(buf, argv[2]) == 0) {
+ id = GetDlgCtrlID(child);
+ break;
+ }
+ child = GetWindow(child, GW_HWNDNEXT);
+ }
+ if (child == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
+ if (message < 0) {
+ message = strtol(argv[3], NULL, 0);
+ }
+ wParam = 0;
+ lParam = 0;
+
+ if (argc > 4) {
+ wParam = strtol(argv[4], NULL, 0);
+ }
+ if (argc > 5) {
+ lParam = strtol(argv[5], NULL, 0);
+ }
+
+ switch (message) {
+ case WM_GETTEXT: {
+ Tcl_DString ds;
+ char buf[256];
+
+ GetDlgItemText(hwnd, id, buf, 256);
+ Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
+ Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ case WM_SETTEXT: {
+ Tcl_DString ds;
+
+ Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
+ SetDlgItemText(hwnd, id, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ break;
+ }
+ default: {
+ char buf[TCL_INTEGER_SPACE];
+
+ sprintf(buf, "%d",
+ SendDlgItemMessage(hwnd, id, message, wParam, lParam));
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+
+
+
+
diff --git a/tk/win/tkWinWindow.c b/tk/win/tkWinWindow.c
index f78dd0b9c74..6980f39bca1 100644
--- a/tk/win/tkWinWindow.c
+++ b/tk/win/tkWinWindow.c
@@ -4,7 +4,7 @@
* Xlib emulation routines for Windows related to creating,
* displaying and destroying windows.
*
- * Copyright (c) 1995 Sun Microsystems, Inc.
+ * 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.
@@ -14,17 +14,12 @@
#include "tkWinInt.h"
-/*
- * The windowTable maps from HWND to Tk_Window handles.
- */
-
-static Tcl_HashTable windowTable;
-
-/*
- * Have statics in this module been initialized?
- */
-
-static int initialized = 0;
+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:
@@ -61,10 +56,12 @@ Tk_AttachHWND(tkwin, hwnd)
int new;
Tcl_HashEntry *entryPtr;
TkWinDrawable *twdPtr = (TkWinDrawable *) Tk_WindowId(tkwin);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (!initialized) {
- Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
- initialized = 1;
+ if (!tsdPtr->initialized) {
+ Tcl_InitHashTable(&tsdPtr->windowTable, TCL_ONE_WORD_KEYS);
+ tsdPtr->initialized = 1;
}
/*
@@ -77,7 +74,7 @@ Tk_AttachHWND(tkwin, hwnd)
twdPtr->type = TWD_WINDOW;
twdPtr->window.winPtr = (TkWindow *) tkwin;
} else if (twdPtr->window.handle != NULL) {
- entryPtr = Tcl_FindHashEntry(&windowTable,
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable,
(char *)twdPtr->window.handle);
Tcl_DeleteHashEntry(entryPtr);
}
@@ -87,7 +84,7 @@ Tk_AttachHWND(tkwin, hwnd)
*/
twdPtr->window.handle = hwnd;
- entryPtr = Tcl_CreateHashEntry(&windowTable, (char *)hwnd, &new);
+ entryPtr = Tcl_CreateHashEntry(&tsdPtr->windowTable, (char *)hwnd, &new);
Tcl_SetHashValue(entryPtr, (ClientData)tkwin);
return (Window)twdPtr;
@@ -115,11 +112,14 @@ Tk_HWNDToWindow(hwnd)
HWND hwnd;
{
Tcl_HashEntry *entryPtr;
- if (!initialized) {
- Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
- initialized = 1;
+ 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(&windowTable, (char*)hwnd);
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd);
if (entryPtr != NULL) {
return (Tk_Window) Tcl_GetHashValue(entryPtr);
}
@@ -190,7 +190,7 @@ TkpPrintWindowId(buf, window)
* The return value is normally TCL_OK; in this case *idPtr
* will be set to the X Window id equivalent to string. If
* string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in interp->result. If the
+ * 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.
*
@@ -295,6 +295,8 @@ XDestroyWindow(display, w)
TkWinDrawable *twdPtr = (TkWinDrawable *)w;
TkWindow *winPtr = TkWinGetWinPtr(w);
HWND hwnd = Tk_GetHWND(w);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
display->request++;
@@ -305,7 +307,7 @@ XDestroyWindow(display, w)
TkPointerDeadWindow(winPtr);
- entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd);
+ entryPtr = Tcl_FindHashEntry(&tsdPtr->windowTable, (char*)hwnd);
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
}
@@ -799,3 +801,4 @@ TkpWindowWasRecentlyDeleted(win, dispPtr)
{
return 0;
}
+
diff --git a/tk/win/tkWinWm.c b/tk/win/tkWinWm.c
index c8b17d8dcd0..8f7ba87d999 100644
--- a/tk/win/tkWinWm.c
+++ b/tk/win/tkWinWm.c
@@ -7,7 +7,7 @@
* to the window manager.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * 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.
@@ -164,6 +164,7 @@ typedef struct TkWmInfo {
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;
@@ -183,7 +184,7 @@ typedef struct TkWmInfo {
* 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.
+ * 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
@@ -223,33 +224,8 @@ typedef struct TkWmInfo {
#define WM_TRANSIENT_STYLE \
(WS_POPUP|WS_CAPTION|WS_SYSMENU|WS_CLIPSIBLINGS|CS_DBLCLKS)
-/* CYGNUS LOCAL: We don't want WS_EX_TOOLWINDOW for most of our
- transient windows. If necessary, we can add some option to set
- this.
- #define EX_TRANSIENT_STYLE (WS_EX_TOOLWINDOW | WS_EX_DLGMODALFRAME)
- We also don't use WS_EX_DLGMODALFRAME. Using this doesn't give any
- obvious benefit. However, it does have a drawback: if the window
- is marked as not resizable, then use of WS_EX_DLGMODALFRAME will
- cause the resize items on the window's system menu to remain
- active. No, I don't understand.
- */
-#define EX_TRANSIENT_STYLE (0)
-
-/*
- * This module keeps a list of all top-level windows.
- */
-
-static WmInfo *firstWmPtr = NULL; /* Points to first top-level window. */
-static WmInfo *foregroundWmPtr = NULL; /* Points to the foreground window. */
-
-/*
- * The variable below is used to enable or disable tracing in this
- * module. If tracing is enabled, then information is printed on
- * standard output about interesting interactions with the window
- * manager.
- */
-
-static int wmTracing = 0;
+#define EX_TRANSIENT_STYLE \
+ (WS_EX_TOOLWINDOW|WS_EX_DLGMODALFRAME)
/*
* The following structure is the official type record for geometry
@@ -264,41 +240,36 @@ static Tk_GeomMgr wmMgrType = {
(Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
};
-/*
- * Global system palette. This value always refers to the currently
- * installed foreground logical palette.
- */
-
-static HPALETTE systemPalette = NULL;
+typedef struct ThreadSpecificData {
+ HPALETTE systemPalette; /* System palette; refers to the
+ * currently installed foreground logical
+ * palette. */
+ TkWindow *createWindow; /* Window that is being constructed. This
+ * value is set immediately before a
+ * call to CreateWindowEx, and is used
+ * by SetLimits. This is a gross hack
+ * needed to work around Windows brain
+ * damage where it sends the
+ * WM_GETMINMAXINFO message before the
+ * WM_CREATE window. */
+ int initialized; /* Flag indicating whether thread-
+ * specific elements of module have
+ * been initialized. */
+ int firstWindow; /* Flag, cleared when the first window
+ * is mapped in a non-iconic state. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
- * 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.
+ * The following variables cannot be placed in thread local storage
+ * because they must be shared across threads.
*/
-static TkWindow *createWindow = NULL;
+static WNDCLASS toplevelClass; /* Class for toplevel windows. */
+static int initialized; /* Flag indicating whether module has
+ * been initialized. */
+TCL_DECLARE_MUTEX(winWmMutex)
-/*
- * Flag indicating whether this module has been initialized yet.
- */
-
-static int initialized = 0;
-
-/*
- * Class for toplevel windows.
- */
-
-static WNDCLASS toplevelClass;
-
-/*
- * This flag is cleared when the first window is mapped in a non-iconic
- * state.
- */
-
-static int firstWindow = 1;
/*
* Forward declarations for procedures defined in this file:
@@ -323,7 +294,8 @@ static void InvalidateSubTree _ANSI_ARGS_((TkWindow *winPtr,
Colormap colormap));
static int ParseGeometry _ANSI_ARGS_((Tcl_Interp *interp,
char *string, TkWindow *winPtr));
-static void RefreshColormap _ANSI_ARGS_((Colormap colormap));
+static void RefreshColormap _ANSI_ARGS_((Colormap colormap,
+ TkDisplay *dispPtr));
static void SetLimits _ANSI_ARGS_((HWND hwnd, MINMAXINFO *info));
static LRESULT CALLBACK TopLevelProc _ANSI_ARGS_((HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam));
@@ -336,6 +308,8 @@ static void UpdateGeometryInfo _ANSI_ARGS_((
static void UpdateWrapper _ANSI_ARGS_((TkWindow *winPtr));
static LRESULT CALLBACK WmProc _ANSI_ARGS_((HWND hwnd, UINT message,
WPARAM wParam, LPARAM lParam));
+static void WmWaitVisibilityProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
/*
*----------------------------------------------------------------------
@@ -356,28 +330,49 @@ static LRESULT CALLBACK WmProc _ANSI_ARGS_((HWND hwnd, UINT message,
static void
InitWm(void)
{
- if (initialized) {
- return;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ WNDCLASS * classPtr;
+
+ if (! tsdPtr->initialized) {
+ tsdPtr->initialized = 1;
+ tsdPtr->firstWindow = 1;
}
- initialized = 1;
-
- toplevelClass.style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;
- toplevelClass.cbClsExtra = 0;
- toplevelClass.cbWndExtra = 0;
- toplevelClass.hInstance = Tk_GetHINSTANCE();
- toplevelClass.hbrBackground = NULL;
- toplevelClass.lpszMenuName = NULL;
- toplevelClass.lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME;
- toplevelClass.lpfnWndProc = WmProc;
- /* CYGNUS LOCAL: First try the application's resource file. If
- that fails, then try the Tk DLL. */
- toplevelClass.hIcon = LoadIcon (GetModuleHandle (NULL), "tk");
- if (toplevelClass.hIcon == NULL)
- toplevelClass.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
- toplevelClass.hCursor = LoadCursor(NULL, IDC_ARROW);
-
- if (!RegisterClass(&toplevelClass)) {
- panic("Unable to register TkTopLevel class");
+ if (! initialized) {
+ Tcl_MutexLock(&winWmMutex);
+ if (! initialized) {
+ initialized = 1;
+ classPtr = &toplevelClass;
+
+ /*
+ * When threads are enabled, we cannot use CLASSDC because
+ * threads will then write into the same device context.
+ *
+ * This is a hack; we should add a subsystem that manages
+ * device context on a per-thread basis. See also tkWinX.c,
+ * which also initializes a WNDCLASS structure.
+ */
+
+#ifdef TCL_THREADS
+ classPtr->style = CS_HREDRAW | CS_VREDRAW;
+#else
+ classPtr->style = CS_HREDRAW | CS_VREDRAW | CS_CLASSDC;
+#endif
+ classPtr->cbClsExtra = 0;
+ classPtr->cbWndExtra = 0;
+ classPtr->hInstance = Tk_GetHINSTANCE();
+ classPtr->hbrBackground = NULL;
+ classPtr->lpszMenuName = NULL;
+ classPtr->lpszClassName = TK_WIN_TOPLEVEL_CLASS_NAME;
+ classPtr->lpfnWndProc = WmProc;
+ classPtr->hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
+ classPtr->hCursor = LoadCursor(NULL, IDC_ARROW);
+
+ if (!RegisterClass(classPtr)) {
+ panic("Unable to register TkTopLevel class");
+ }
+ }
+ Tcl_MutexUnlock(&winWmMutex);
}
}
@@ -402,14 +397,17 @@ 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 (createWindow) {
- return createWindow;
+ if (tsdPtr->createWindow) {
+ return tsdPtr->createWindow;
}
return (TkWindow *) GetWindowLong(hwnd, GWL_USERDATA);
}
@@ -523,10 +521,26 @@ void
TkWinWmCleanup(hInstance)
HINSTANCE hInstance;
{
- if (!initialized) {
+ 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;
}
- initialized = 0;
+#endif
+
+ tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ if (!tsdPtr->initialized) {
+ return;
+ }
+ tsdPtr->initialized = 0;
UnregisterClass(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance);
}
@@ -602,6 +616,7 @@ TkWmNewWindow(winPtr)
wmPtr->cmapList = NULL;
wmPtr->cmapCount = 0;
+ wmPtr->numTransients = 0;
wmPtr->configWidth = -1;
wmPtr->configHeight = -1;
@@ -609,8 +624,8 @@ TkWmNewWindow(winPtr)
wmPtr->cmdArgv = NULL;
wmPtr->clientMachine = NULL;
wmPtr->flags = WM_NEVER_MAPPED;
- wmPtr->nextPtr = firstWmPtr;
- firstWmPtr = wmPtr;
+ wmPtr->nextPtr = winPtr->dispPtr->firstWmPtr;
+ winPtr->dispPtr->firstWmPtr = wmPtr;
/*
* Tk must monitor structure events for top-level windows, in order
@@ -657,9 +672,13 @@ UpdateWrapper(winPtr)
HWND child = TkWinGetHWND(winPtr->window);
int x, y, width, height, state;
WINDOWPLACEMENT place;
+ Tcl_DString titleString;
+ int *childStateInfo = NULL;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
parentHWND = NULL;
- child = TkWinGetHWND(winPtr->window);
+ child = TkWinGetHWND(winPtr->window);
if (winPtr->flags & TK_EMBEDDED) {
wmPtr->wrapper = (HWND) winPtr->privatePtr;
@@ -675,11 +694,11 @@ UpdateWrapper(winPtr)
* Pick the decorative frame style. Override redirect windows get
* created as undecorated popups. Transient windows get a modal
* dialog frame. Neither override, nor transient windows appear in
- * the Win95 taskbar. Note that a transient window does not resize
+ * 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;
@@ -696,10 +715,8 @@ UpdateWrapper(winPtr)
wmPtr->exStyle = EX_TOPLEVEL_STYLE;
}
- /* CYGNUS LOCAL: nonresizable windows have no maximize box,
- and no "sizebox". */
if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE)
- && (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
+ && (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
wmPtr->style &= ~ (WS_MAXIMIZEBOX | WS_SIZEBOX);
}
@@ -720,7 +737,6 @@ UpdateWrapper(winPtr)
* pick a location.
*/
-
if (!(wmPtr->sizeHintsFlags & (USPosition | PPosition))
&& (wmPtr->flags & WM_NEVER_MAPPED)) {
x = CW_USEDEFAULT;
@@ -735,13 +751,15 @@ UpdateWrapper(winPtr)
* to the TkWindow.
*/
- createWindow = winPtr;
+ tsdPtr->createWindow = winPtr;
+ Tcl_UtfToExternalDString(NULL, wmPtr->titleUid, -1, &titleString);
wmPtr->wrapper = CreateWindowEx(wmPtr->exStyle,
TK_WIN_TOPLEVEL_CLASS_NAME,
- wmPtr->titleUid, wmPtr->style, x, y, width, height,
- parentHWND, NULL, Tk_GetHINSTANCE(), NULL);
+ Tcl_DStringValue(&titleString), wmPtr->style, x, y, width,
+ height, parentHWND, NULL, Tk_GetHINSTANCE(), NULL);
+ Tcl_DStringFree(&titleString);
SetWindowLong(wmPtr->wrapper, GWL_USERDATA, (LONG) winPtr);
- createWindow = NULL;
+ tsdPtr->createWindow = NULL;
place.length = sizeof(WINDOWPLACEMENT);
GetWindowPlacement(wmPtr->wrapper, &place);
@@ -767,6 +785,26 @@ UpdateWrapper(winPtr)
&& (oldWrapper != GetDesktopWindow())) {
SetWindowLong(oldWrapper, GWL_USERDATA, (LONG) NULL);
+ 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.
@@ -775,6 +813,7 @@ UpdateWrapper(winPtr)
SetMenu(oldWrapper, NULL);
DestroyWindow(oldWrapper);
}
+
wmPtr->flags &= ~WM_NEVER_MAPPED;
SendMessage(wmPtr->wrapper, TK_ATTACHWINDOW, (WPARAM) child, 0);
@@ -810,13 +849,35 @@ UpdateWrapper(winPtr)
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 (firstWindow) {
- firstWindow = 0;
+ if (tsdPtr->firstWindow) {
+ tsdPtr->firstWindow = 0;
SetActiveWindow(wmPtr->wrapper);
}
}
@@ -850,8 +911,10 @@ TkWmMapWindow(winPtr)
* be mapped. */
{
register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (!initialized) {
+ if (!tsdPtr->initialized) {
InitWm();
}
@@ -931,8 +994,9 @@ TkpWmSetState(winPtr, state)
{
WmInfo *wmPtr = winPtr->wmInfoPtr;
int cmd;
-
- if (wmPtr->flags & WM_NEVER_MAPPED) {
+
+ if ((wmPtr->flags & WM_NEVER_MAPPED) ||
+ (wmPtr->masterPtr && !Tk_IsMapped(wmPtr->masterPtr))) {
wmPtr->hints.initial_state = state;
return;
}
@@ -947,6 +1011,7 @@ TkpWmSetState(winPtr, state)
} else if (state == ZoomState) {
cmd = SW_SHOWMAXIMIZED;
}
+
ShowWindow(wmPtr->wrapper, cmd);
wmPtr->flags &= ~WM_SYNC_PENDING;
}
@@ -984,11 +1049,12 @@ TkWmDeadWindow(winPtr)
* Clean up event related window info.
*/
- if (firstWmPtr == wmPtr) {
- firstWmPtr = wmPtr->nextPtr;
+ if (winPtr->dispPtr->firstWmPtr == wmPtr) {
+ winPtr->dispPtr->firstWmPtr = wmPtr->nextPtr;
} else {
register WmInfo *prevPtr;
- for (prevPtr = firstWmPtr; ; prevPtr = prevPtr->nextPtr) {
+ for (prevPtr = winPtr->dispPtr->firstWmPtr; ;
+ prevPtr = prevPtr->nextPtr) {
if (prevPtr == NULL) {
panic("couldn't unlink window in TkWmDeadWindow");
}
@@ -1003,7 +1069,8 @@ TkWmDeadWindow(winPtr)
* Reset all transient windows whose master is the dead window.
*/
- for (wmPtr2 = firstWmPtr; wmPtr2 != NULL; wmPtr2 = wmPtr2->nextPtr) {
+ for (wmPtr2 = winPtr->dispPtr->firstWmPtr; wmPtr2 != NULL;
+ wmPtr2 = wmPtr2->nextPtr) {
if (wmPtr2->masterPtr == winPtr) {
wmPtr2->masterPtr = NULL;
if ((wmPtr2->wrapper != None)
@@ -1047,6 +1114,20 @@ TkWmDeadWindow(winPtr)
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,
+ WmWaitVisibilityProc, (ClientData) winPtr);
+ wmPtr->masterPtr = NULL;
+ }
/*
* Destroy the decorative frame window.
@@ -1117,10 +1198,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
char **argv; /* Argument strings. */
{
Tk_Window tkwin = (Tk_Window) clientData;
- TkWindow *winPtr;
+ TkWindow *winPtr = NULL;
register WmInfo *wmPtr;
int c;
size_t length;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
if (argc < 2) {
wrongNumArgs:
@@ -1138,10 +1220,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 2) {
- interp->result = (wmTracing) ? "on" : "off";
+ Tcl_SetResult(interp, ((dispPtr->wmTracing) ? "on" : "off"),
+ TCL_STATIC);
return TCL_OK;
}
- return Tcl_GetBoolean(interp, argv[2], &wmTracing);
+ return Tcl_GetBoolean(interp, argv[2], &dispPtr->wmTracing);
}
if (argc < 3) {
@@ -1168,9 +1251,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PAspect) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->minAspect.x,
+ 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;
}
@@ -1185,7 +1271,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if ((numer1 <= 0) || (denom1 <= 0) || (numer2 <= 0) ||
(denom2 <= 0)) {
- interp->result = "aspect number can't be <= 0";
+ Tcl_SetResult(interp, "aspect number can't be <= 0",
+ TCL_STATIC);
return TCL_ERROR;
}
wmPtr->minAspect.x = numer1;
@@ -1205,7 +1292,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->clientMachine != NULL) {
- interp->result = wmPtr->clientMachine;
+ Tcl_SetResult(interp, wmPtr->clientMachine, TCL_STATIC);
}
return TCL_OK;
}
@@ -1301,7 +1388,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
* Now we need to force the updated colormaps to be installed.
*/
- if (wmPtr == foregroundWmPtr) {
+ if (wmPtr == winPtr->dispPtr->foregroundWmPtr) {
InstallColormaps(wmPtr->wrapper, WM_QUERYNEWPALETTE, 1);
} else {
InstallColormaps(wmPtr->wrapper, WM_PALETTECHANGED, 0);
@@ -1320,8 +1407,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->cmdArgv != NULL) {
- interp->result = Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv);
- interp->freeProc = TCL_DYNAMIC;
+ Tcl_SetResult(interp,
+ Tcl_Merge(wmPtr->cmdArgc, wmPtr->cmdArgv),
+ TCL_DYNAMIC);
}
return TCL_OK;
}
@@ -1363,7 +1451,34 @@ Tk_WmCmd(clientData, interp, argc, argv)
": it is an embedded window", (char *) NULL);
return TCL_ERROR;
}
- TkpWmSetState(winPtr, NormalState);
+ /*
+ * If WM_UPDATE_PENDING is true, a pending UpdateGeometryInfo may
+ * need to be called first to update a withdrew toplevel's geometry
+ * before it is deiconified by TkpWmSetState.
+ * Don't bother if we've never been mapped.
+ */
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ 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);
+ }
+
+ /*
+ * 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);
+ }
} else if ((c == 'f') && (strncmp(argv[1], "focusmodel", length) == 0)
&& (length >= 2)) {
if ((argc != 3) && (argc != 4)) {
@@ -1373,7 +1488,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = wmPtr->hints.input ? "passive" : "active";
+ Tcl_SetResult(interp, (wmPtr->hints.input ? "passive" : "active"),
+ TCL_STATIC);
return TCL_OK;
}
c = argv[3][0];
@@ -1390,6 +1506,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
} else if ((c == 'f') && (strncmp(argv[1], "frame", length) == 0)
&& (length >= 2)) {
HWND hwnd;
+ char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
@@ -1403,7 +1520,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
if (hwnd == NULL) {
hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) winPtr));
}
- sprintf(interp->result, "0x%x", (unsigned int) hwnd);
+ sprintf(buf, "0x%x", (unsigned int) hwnd);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
} else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)
&& (length >= 2)) {
char xSign, ySign;
@@ -1416,6 +1534,8 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[16 + TCL_INTEGER_SPACE * 4];
+
xSign = (wmPtr->flags & WM_NEGATIVE_X) ? '-' : '+';
ySign = (wmPtr->flags & WM_NEGATIVE_Y) ? '-' : '+';
if (wmPtr->gridWin != NULL) {
@@ -1427,8 +1547,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
width = winPtr->changes.width;
height = winPtr->changes.height;
}
- sprintf(interp->result, "%dx%d%c%d%c%d", width, height,
- xSign, wmPtr->x, ySign, wmPtr->y);
+ sprintf(buf, "%dx%d%c%d%c%d", width, height, xSign, wmPtr->x,
+ ySign, wmPtr->y);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if (*argv[3] == '\0') {
@@ -1449,9 +1570,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & PBaseSize) {
- sprintf(interp->result, "%d %d %d %d", wmPtr->reqGridWidth,
+ 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;
}
@@ -1478,19 +1602,19 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (reqWidth < 0) {
- interp->result = "baseWidth can't be < 0";
+ Tcl_SetResult(interp, "baseWidth can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (reqHeight < 0) {
- interp->result = "baseHeight can't be < 0";
+ Tcl_SetResult(interp, "baseHeight can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (widthInc < 0) {
- interp->result = "widthInc can't be < 0";
+ Tcl_SetResult(interp, "widthInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
if (heightInc < 0) {
- interp->result = "heightInc can't be < 0";
+ Tcl_SetResult(interp, "heightInc can't be < 0", TCL_STATIC);
return TCL_ERROR;
}
Tk_SetGrid((Tk_Window) winPtr, reqWidth, reqHeight, widthInc,
@@ -1509,7 +1633,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & WindowGroupHint) {
- interp->result = wmPtr->leaderName;
+ Tcl_SetResult(interp, wmPtr->leaderName, TCL_STATIC);
}
return TCL_OK;
}
@@ -1542,8 +1666,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPixmapHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_pixmap);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display,
+ wmPtr->hints.icon_pixmap), TCL_STATIC);
}
return TCL_OK;
}
@@ -1601,8 +1726,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconMaskHint) {
- interp->result = Tk_NameOfBitmap(winPtr->display,
- wmPtr->hints.icon_mask);
+ Tcl_SetResult(interp,
+ Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_mask),
+ TCL_STATIC);
}
return TCL_OK;
}
@@ -1627,7 +1753,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->iconName != NULL) ? wmPtr->iconName : "";
+ Tcl_SetResult(interp,
+ ((wmPtr->iconName != NULL) ? wmPtr->iconName : ""),
+ TCL_STATIC);
return TCL_OK;
} else {
wmPtr->iconName = Tk_GetUid(argv[3]);
@@ -1647,8 +1775,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->hints.flags & IconPositionHint) {
- sprintf(interp->result, "%d %d", wmPtr->hints.icon_x,
+ 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;
}
@@ -1677,7 +1808,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->icon != NULL) {
- interp->result = Tk_PathName(wmPtr->icon);
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->icon), TCL_STATIC);
}
return TCL_OK;
}
@@ -1744,8 +1875,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
if (!(wmPtr2->flags & WM_NEVER_MAPPED)) {
if (XWithdrawWindow(Tk_Display(tkwin2), Tk_WindowId(tkwin2),
Tk_ScreenNumber(tkwin2)) == 0) {
- interp->result =
- "couldn't send withdraw message to window manager";
+ Tcl_SetResult(interp,
+ "couldn't send withdraw message to window manager",
+ TCL_STATIC);
return TCL_ERROR;
}
}
@@ -1760,8 +1892,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
GetMaxSize(wmPtr, &width, &height);
- sprintf(interp->result, "%d %d", width, height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1781,8 +1916,11 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
+ char buf[TCL_INTEGER_SPACE * 2];
+
GetMinSize(wmPtr, &width, &height);
- sprintf(interp->result, "%d %d", width, height);
+ sprintf(buf, "%d %d", width, height);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetInt(interp, argv[3], &width) != TCL_OK)
@@ -1794,7 +1932,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
goto updateGeom;
} else if ((c == 'o')
&& (strncmp(argv[1], "overrideredirect", length) == 0)) {
- int boolean;
+ int boolean, curValue;
XSetWindowAttributes atts;
if ((argc != 3) && (argc != 4)) {
@@ -1803,23 +1941,26 @@ Tk_WmCmd(clientData, interp, argc, argv)
(char *) NULL);
return TCL_ERROR;
}
+ curValue = Tk_Attributes((Tk_Window) winPtr)->override_redirect;
if (argc == 3) {
- if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
- interp->result = "1";
- } else {
- interp->result = "0";
- }
+ Tcl_SetBooleanObj(Tcl_GetObjResult(interp), curValue);
return TCL_OK;
}
if (Tcl_GetBoolean(interp, argv[3], &boolean) != TCL_OK) {
return TCL_ERROR;
}
- atts.override_redirect = (boolean) ? True : False;
- Tk_ChangeWindowAttributes((Tk_Window) winPtr, CWOverrideRedirect,
- &atts);
- if (!(wmPtr->flags & (WM_NEVER_MAPPED)
- && !(winPtr->flags & TK_EMBEDDED))) {
- UpdateWrapper(winPtr);
+ 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);
+ }
}
} else if ((c == 'p') && (strncmp(argv[1], "positionfrom", length) == 0)
&& (length >= 2)) {
@@ -1831,9 +1972,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USPosition) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PPosition) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1887,7 +2028,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protPtr->protocol == protocol) {
- interp->result = protPtr->command;
+ Tcl_SetResult(interp, protPtr->command, TCL_STATIC);
return TCL_OK;
}
}
@@ -1931,9 +2072,12 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- sprintf(interp->result, "%d %d",
+ char buf[TCL_INTEGER_SPACE * 2];
+
+ sprintf(buf, "%d %d",
(wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) ? 0 : 1,
(wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) ? 0 : 1);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
return TCL_OK;
}
if ((Tcl_GetBoolean(interp, argv[3], &width) != TCL_OK)
@@ -1950,7 +2094,10 @@ Tk_WmCmd(clientData, interp, argc, argv)
} else {
wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE;
}
- wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!((wmPtr->flags & WM_NEVER_MAPPED)
+ && !(winPtr->flags & TK_EMBEDDED))) {
+ UpdateWrapper(winPtr);
+ }
goto updateGeom;
} else if ((c == 's') && (strncmp(argv[1], "sizefrom", length) == 0)
&& (length >= 2)) {
@@ -1962,9 +2109,9 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (argc == 3) {
if (wmPtr->sizeHintsFlags & USSize) {
- interp->result = "user";
+ Tcl_SetResult(interp, "user", TCL_STATIC);
} else if (wmPtr->sizeHintsFlags & PSize) {
- interp->result = "program";
+ Tcl_SetResult(interp, "program", TCL_STATIC);
}
return TCL_OK;
}
@@ -1989,27 +2136,80 @@ Tk_WmCmd(clientData, interp, argc, argv)
goto updateGeom;
} else if ((c == 's') && (strncmp(argv[1], "state", length) == 0)
&& (length >= 2)) {
- if (argc != 3) {
+ if ((argc < 3) || (argc > 4)) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
- argv[0], " state window\"", (char *) NULL);
+ argv[0], " state window ?state?\"", (char *) NULL);
return TCL_ERROR;
}
- if (wmPtr->iconFor != NULL) {
- interp->result = "icon";
+ if (argc == 4) {
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't change state of ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't change state of ",
+ winPtr->pathName, ": it is an embedded window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = argv[3][0];
+ length = strlen(argv[3]);
+
+ if ((c == 'n') && (strncmp(argv[3], "normal", length) == 0)) {
+ TkpWmSetState(winPtr, NormalState);
+ /*
+ * This varies from 'wm deiconify' because it does not
+ * force the window to be raised and receive focus
+ */
+ } else if ((c == 'i')
+ && (strncmp(argv[3], "iconic", length) == 0)) {
+ 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 ((c == 'w')
+ && (strncmp(argv[3], "withdrawn", length) == 0)) {
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else if ((c == 'z')
+ && (strncmp(argv[3], "zoomed", length) == 0)) {
+ TkpWmSetState(winPtr, ZoomState);
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be normal, iconic, withdrawn or zoomed",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
} else {
- switch (wmPtr->hints.initial_state) {
- case NormalState:
- interp->result = "normal";
- break;
- case IconicState:
- interp->result = "iconic";
- break;
- case WithdrawnState:
- interp->result = "withdrawn";
- break;
- case ZoomState:
- interp->result = "zoomed";
- break;
+ if (wmPtr->iconFor != NULL) {
+ Tcl_SetResult(interp, "icon", TCL_STATIC);
+ } else {
+ switch (wmPtr->hints.initial_state) {
+ case NormalState:
+ Tcl_SetResult(interp, "normal", TCL_STATIC);
+ break;
+ case IconicState:
+ Tcl_SetResult(interp, "iconic", TCL_STATIC);
+ break;
+ case WithdrawnState:
+ Tcl_SetResult(interp, "withdrawn", TCL_STATIC);
+ break;
+ case ZoomState:
+ Tcl_SetResult(interp, "zoomed", TCL_STATIC);
+ break;
+ }
}
}
} else if ((c == 't') && (strncmp(argv[1], "title", length) == 0)
@@ -2020,18 +2220,22 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- interp->result = (wmPtr->titleUid != NULL) ? wmPtr->titleUid
- : winPtr->nameUid;
+ Tcl_SetResult(interp, ((wmPtr->titleUid != NULL) ?
+ wmPtr->titleUid : winPtr->nameUid), TCL_STATIC);
return TCL_OK;
} else {
wmPtr->titleUid = Tk_GetUid(argv[3]);
if (!(wmPtr->flags & WM_NEVER_MAPPED) && wmPtr->wrapper != NULL) {
- SetWindowText(wmPtr->wrapper, wmPtr->titleUid);
+ Tcl_DString titleString;
+ Tcl_UtfToExternalDString(NULL, wmPtr->titleUid, -1,
+ &titleString);
+ SetWindowText(wmPtr->wrapper, Tcl_DStringValue(&titleString));
+ Tcl_DStringFree(&titleString);
}
}
} else if ((c == 't') && (strncmp(argv[1], "transient", length) == 0)
&& (length >= 3)) {
- TkWindow *masterPtr;
+ TkWindow *masterPtr = wmPtr->masterPtr;
if ((argc != 3) && (argc != 4)) {
Tcl_AppendResult(interp, "wrong # arguments: must be \"",
@@ -2039,12 +2243,21 @@ Tk_WmCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
if (argc == 3) {
- if (wmPtr->masterPtr != NULL) {
- Tcl_SetResult(interp, Tk_PathName(wmPtr->masterPtr),
- TCL_STATIC);
+ if (masterPtr != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(masterPtr), TCL_STATIC);
}
return TCL_OK;
}
+ 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,
+ WmWaitVisibilityProc, (ClientData) winPtr);
+ }
if (argv[3][0] == '\0') {
wmPtr->masterPtr = NULL;
} else {
@@ -2054,7 +2267,7 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
if (masterPtr == winPtr) {
wmPtr->masterPtr = NULL;
- } else {
+ } else if (masterPtr != wmPtr->masterPtr) {
Tk_MakeWindowExist((Tk_Window)masterPtr);
/*
@@ -2065,16 +2278,20 @@ Tk_WmCmd(clientData, interp, argc, argv)
masterPtr = masterPtr->parentPtr;
}
wmPtr->masterPtr = masterPtr;
+ masterPtr->wmInfoPtr->numTransients++;
/*
- * Ensure that the transient window is either mapped or
- * unmapped like its master.
+ * Bind a visibility event handler to the master window,
+ * to ensure that when it is mapped, the children will
+ * have their state set properly.
*/
- TkpWmSetState(winPtr, NormalState);
+ Tk_CreateEventHandler((Tk_Window) masterPtr,
+ VisibilityChangeMask,
+ WmWaitVisibilityProc, (ClientData) winPtr);
}
}
- if (!(wmPtr->flags & (WM_NEVER_MAPPED)
+ if (!((wmPtr->flags & WM_NEVER_MAPPED)
&& !(winPtr->flags & TK_EMBEDDED))) {
UpdateWrapper(winPtr);
}
@@ -2111,6 +2328,26 @@ Tk_WmCmd(clientData, interp, argc, argv)
}
return TCL_OK;
}
+ /*ARGSUSED*/
+static void
+WmWaitVisibilityProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ TkWindow *masterPtr = winPtr->wmInfoPtr->masterPtr;
+
+ if ((eventPtr->type == VisibilityNotify) && (masterPtr != NULL)) {
+ 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);
+ }
+ }
+ }
+}
/*
*----------------------------------------------------------------------
@@ -2621,7 +2858,7 @@ UpdateGeometryInfo(clientData)
*
* Results:
* A standard Tcl return value, plus an error message in
- * interp->result if an error occurs.
+ * the interp's result if an error occurs.
*
* Side effects:
* The size and/or location of winPtr may change.
@@ -2968,14 +3205,19 @@ TkWmProtocolEventProc(winPtr, eventPtr)
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.
+ */
+ 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,
- Tk_GetAtomName((Tk_Window) winPtr, protocol));
+ Tcl_AddErrorInfo(interp, name);
Tcl_AddErrorInfo(interp, "\" window manager protocol)");
Tcl_BackgroundError(interp);
}
@@ -3038,7 +3280,6 @@ TkWmRestackToplevel(winPtr, aboveBelow, otherPtr)
hwnd = (winPtr->wmInfoPtr->wrapper != NULL)
? winPtr->wmInfoPtr->wrapper : Tk_GetHWND(winPtr->window);
-
if (otherPtr != NULL) {
if (otherPtr->window == None) {
Tk_MakeWindowExist((Tk_Window) otherPtr);
@@ -3146,7 +3387,7 @@ TkWmAddToColormapWindows(winPtr)
* Now we need to force the updated colormaps to be installed.
*/
- if (topPtr->wmInfoPtr == foregroundWmPtr) {
+ if (topPtr->wmInfoPtr == winPtr->dispPtr->foregroundWmPtr) {
InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_QUERYNEWPALETTE, 1);
} else {
InstallColormaps(topPtr->wmInfoPtr->wrapper, WM_PALETTECHANGED, 0);
@@ -3344,8 +3585,7 @@ ConfigureTopLevel(pos)
*/
if (!(wmPtr->flags & WM_UPDATE_PENDING)) {
- Tcl_DoWhenIdle(UpdateGeometryInfo,
- (ClientData) winPtr);
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
wmPtr->flags |= WM_UPDATE_PENDING;
}
/* fall through */
@@ -3544,6 +3784,8 @@ InstallColormaps(hwnd, message, isForemost)
HPALETTE oldPalette;
TkWindow *winPtr = GetTopLevel(hwnd);
WmInfo *wmPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr == NULL) {
return 0;
@@ -3560,17 +3802,17 @@ InstallColormaps(hwnd, message, isForemost)
* secondary palettes are installed properly.
*/
- foregroundWmPtr = wmPtr;
+ winPtr->dispPtr->foregroundWmPtr = wmPtr;
if (wmPtr->cmapCount > 0) {
winPtr = wmPtr->cmapList[0];
}
- systemPalette = TkWinGetPalette(winPtr->atts.colormap);
+ tsdPtr->systemPalette = TkWinGetPalette(winPtr->atts.colormap);
dc = GetDC(hwnd);
- oldPalette = SelectPalette(dc, systemPalette, FALSE);
+ oldPalette = SelectPalette(dc, tsdPtr->systemPalette, FALSE);
if (RealizePalette(dc)) {
- RefreshColormap(winPtr->atts.colormap);
+ RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
} else if (wmPtr->cmapCount > 1) {
SelectPalette(dc, oldPalette, TRUE);
RealizePalette(dc);
@@ -3606,13 +3848,13 @@ InstallColormaps(hwnd, message, isForemost)
oldPalette = SelectPalette(dc,
TkWinGetPalette(winPtr->atts.colormap), TRUE);
if (RealizePalette(dc)) {
- RefreshColormap(winPtr->atts.colormap);
+ 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);
+ RefreshColormap(winPtr->atts.colormap, winPtr->dispPtr);
}
}
}
@@ -3644,13 +3886,14 @@ InstallColormaps(hwnd, message, isForemost)
*/
static void
-RefreshColormap(colormap)
+RefreshColormap(colormap, dispPtr)
Colormap colormap;
+ TkDisplay *dispPtr;
{
WmInfo *wmPtr;
int i;
- for (wmPtr = firstWmPtr; wmPtr != NULL; wmPtr = wmPtr->nextPtr) {
+ 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)
@@ -3732,7 +3975,10 @@ InvalidateSubTree(winPtr, colormap)
HPALETTE
TkWinGetSystemPalette()
{
- return systemPalette;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->systemPalette;
}
/*
@@ -3960,8 +4206,8 @@ WmProc(hwnd, message, wParam, lParam)
* leaving move/size mode. Note that this mechanism
* assumes move/size is only one level deep. */
LRESULT result;
- TkWindow *winPtr;
-
+ TkWindow *winPtr = NULL;
+
if (TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &result)) {
goto done;
}
@@ -3975,10 +4221,12 @@ WmProc(hwnd, message, wParam, lParam)
case WM_ENTERSIZEMOVE:
inMoveSize = 1;
- /* CYGNUS LOCAL: Cancel any current mouse timer before we
- start looking for events. If the mouse timer fires, it
- will release the size/move mouse capture, which is
- wrong. */
+ /*
+ * 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);
@@ -4032,9 +4280,18 @@ WmProc(hwnd, message, wParam, lParam)
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 = DefWindowProc(hwnd, message, wParam, lParam);
+ goto done;
+ }
+
/*
- * Don't activate the window yet since there may be grabs
- * that should take precedence. Instead we need to queue
+ * 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.
*/
@@ -4049,21 +4306,6 @@ WmProc(hwnd, message, wParam, lParam)
goto done;
}
- /* CYGNUS LOCAL. */
- case WM_SETTINGCHANGE:
- if (wParam == SPI_SETNONCLIENTMETRICS) {
- winPtr = GetTopLevel(hwnd);
- if (winPtr != NULL) {
- TkWinNCMetricsChanged((Tk_Window) winPtr);
- }
- }
- break;
-
- /* CYGNUS LOCAL. */
- case WM_SYSCOLORCHANGE:
- TkWinSysColorChange();
- break;
-
default:
break;
}
@@ -4099,7 +4341,7 @@ WmProc(hwnd, message, wParam, lParam)
* None.
*
* Side effects:
- * Changes the style bit used to create a new Mac toplevel.
+ * Changes the style bit used to create a new toplevel.
*
*----------------------------------------------------------------------
*/
@@ -4258,3 +4500,35 @@ ActivateWindow(
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/tk/win/tkWinX.c b/tk/win/tkWinX.c
index 3a5bbe9d1ee..aed6113e888 100644
--- a/tk/win/tkWinX.c
+++ b/tk/win/tkWinX.c
@@ -5,7 +5,7 @@
*
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
* Copyright (c) 1994 Software Research Associates, Inc.
- * Copyright (c) 1998 by Scriptics Corporation.
+ * 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.
@@ -13,50 +13,37 @@
* RCS: @(#) $Id$
*/
-#include "tkInt.h"
#include "tkWinInt.h"
-#if defined (__CYGWIN32__) || defined (__MINGW32__)
-/* GCC ports that use Windows32api headers don't provide
- GetCurrentTime, and the function is obsolete anyhow. */
-#define GetCurrentTime GetTickCount
-#endif
-
-/*
- * CYGNUS LOCAL:
- * We don't have a zmouse.h, AND as of gnupro 98r2, the WM_MOUSEWHEEL
- * message is not added to any of the Cygwin defines. So we include
- * it here.
- * FIXME -- remove the define when it gets into the Cygwin header files
- */
-
-#ifdef __CYGWIN32__
-#define WM_MOUSEWHEEL 0x020A
-#else
/*
* The zmouse.h file includes the definition for WM_MOUSEWHEEL.
*/
#include <zmouse.h>
-#endif
/*
- * Definitions of extern variables supplied by this file.
+ * Declarations of static variables used in this file.
*/
-int tkpIsWin32s = -1;
+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; /* version of Windows platform */
+
+TCL_DECLARE_MUTEX(winXMutex)
/*
- * Declarations of static variables used in this file.
+ * 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.
*/
-
-static HINSTANCE tkInstance = (HINSTANCE) NULL;
- /* Global application instance handle. */
-static TkDisplay *winDisplay; /* Display that represents Windows screen. */
-static char winScreenName[] = ":0";
- /* Default name of windows display. */
-static WNDCLASS childClass; /* Window class for child windows. */
-static childClassInitialized = 0; /* Registered child class? */
+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.
@@ -93,16 +80,14 @@ TkGetServerInfo(interp, tkwin)
Tk_Window tkwin; /* Token for window; this selects a
* particular display and server. */
{
- char buffer[50];
- OSVERSIONINFO info;
-
- info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&info);
- sprintf(buffer, "Windows %d.%d %d ", info.dwMajorVersion,
- info.dwMinorVersion, info.dwBuildNumber);
- Tcl_AppendResult(interp, buffer,
- (info.dwPlatformId == VER_PLATFORM_WIN32s) ? "Win32s" : "Win32",
- (char *) NULL);
+ char buffer[60];
+ OSVERSIONINFO os;
+
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&os);
+ sprintf(buffer, "Windows %d.%d %d Win32", os.dwMajorVersion,
+ os.dwMinorVersion, os.dwBuildNumber);
+ Tcl_SetResult(interp, buffer, TCL_VOLATILE);
}
/*
@@ -147,11 +132,7 @@ void
TkWinXInit(hInstance)
HINSTANCE hInstance;
{
- OSVERSIONINFO info;
-
- info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
- GetVersionEx(&info);
- tkpIsWin32s = (info.dwPlatformId == VER_PLATFORM_WIN32s);
+ OSVERSIONINFO os;
if (childClassInitialized != 0) {
return;
@@ -160,7 +141,25 @@ TkWinXInit(hInstance)
tkInstance = hInstance;
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&os);
+ tkPlatformId = os.dwPlatformId;
+
+ /*
+ * 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;
@@ -220,6 +219,32 @@ TkWinXCleanup(hInstance)
/*
*----------------------------------------------------------------------
*
+ * TkWinGetPlatformId --
+ *
+ * Determines whether running under NT, 95, or Win32s, to allow
+ * runtime conditional code.
+ *
+ * Results:
+ * The return value is one of:
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1.
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkWinGetPlatformId()
+{
+ return tkPlatformId;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TkGetDefaultScreenName --
*
* Returns the name of the screen that Tk should use during
@@ -254,10 +279,10 @@ TkGetDefaultScreenName(interp, screenName)
* specific information.
*
* Results:
- * Returns a Display structure on success or NULL on failure.
+ * Returns a TkDisplay structure on success or NULL on failure.
*
* Side effects:
- * Allocates a new Display structure.
+ * Allocates a new TkDisplay structure.
*
*----------------------------------------------------------------------
*/
@@ -270,10 +295,13 @@ TkpOpenDisplay(display_name)
HDC dc;
TkWinDrawable *twdPtr;
Display *display;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (winDisplay != NULL) {
- if (strcmp(winDisplay->display->display_name, display_name) == 0) {
- return winDisplay;
+ if (tsdPtr->winDisplay != NULL) {
+ if (strcmp(tsdPtr->winDisplay->display->display_name, display_name)
+ == 0) {
+ return tsdPtr->winDisplay;
} else {
return NULL;
}
@@ -370,14 +398,15 @@ TkpOpenDisplay(display_name)
screen->white_pixel = RGB(255, 255, 255);
screen->black_pixel = RGB(0, 0, 0);
- display->screens = screen;
- display->nscreens = 1;
- display->default_screen = 0;
+ display->screens = screen;
+ display->nscreens = 1;
+ display->default_screen = 0;
screen->cmap = XCreateColormap(display, None, screen->root_visual,
AllocNone);
- winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
- winDisplay->display = display;
- return winDisplay;
+ tsdPtr->winDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ tsdPtr->winDisplay->display = display;
+ tsdPtr->updatingClipboard = FALSE;
+ return tsdPtr->winDisplay;
}
/*
@@ -403,8 +432,10 @@ TkpCloseDisplay(dispPtr)
{
Display *display = dispPtr->display;
HWND hwnd;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
- if (dispPtr != winDisplay) {
+ if (dispPtr != tsdPtr->winDisplay) {
panic("TkpCloseDisplay: tried to call TkpCloseDisplay on another display");
return;
}
@@ -423,7 +454,7 @@ TkpCloseDisplay(dispPtr)
}
}
- winDisplay = NULL;
+ tsdPtr->winDisplay = NULL;
if (display->display_name != (char *) NULL) {
ckfree(display->display_name);
@@ -506,7 +537,6 @@ TkWinChildProc(hwnd, message, wParam, lParam)
case WM_CREATE:
case WM_ERASEBKGND:
- case WM_WINDOWPOSCHANGED:
result = 0;
break;
@@ -654,6 +684,8 @@ GenerateXEvent(hwnd, message, wParam, lParam)
{
XEvent event;
TkWindow *winPtr = (TkWindow *)Tk_HWNDToWindow(hwnd);
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (!winPtr || winPtr->window == None) {
return;
@@ -718,14 +750,19 @@ GenerateXEvent(hwnd, message, wParam, lParam)
}
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;
- /* CYGNUS LOCAL: Handle WM_MENUCHAR. */
- case WM_MENUCHAR:
case WM_MOUSEWHEEL:
/*
* The mouse wheel event is closer to a key event than a
@@ -815,26 +852,61 @@ GenerateXEvent(hwnd, message, wParam, lParam)
*/
event.type = KeyRelease;
event.xkey.keycode = wParam;
- event.xkey.nchars = 0;
+ event.xkey.nbytes = 0;
break;
- /* CYGNUS LOCAL: Handle WM_MENUCHAR. */
- case WM_MENUCHAR:
- /* For a WM_MENUCHAR message, the character code is
- only the low word. */
- wParam = LOWORD (wParam);
- /* Fall through. */
-
case WM_CHAR:
/*
* Synthesize both a KeyPress and a KeyRelease.
+ * 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.nchars = 1;
+ 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;
@@ -893,7 +965,7 @@ GetState(message, wParam, lParam)
mask = ControlMask;
break;
case VK_MENU:
- mask = Mod2Mask;
+ mask = ALT_MASK;
break;
case VK_CAPITAL:
if (message == WM_SYSKEYDOWN || message == WM_KEYDOWN) {
@@ -933,7 +1005,7 @@ GetState(message, wParam, lParam)
* given KeyPress event.
*
* Results:
- * Sets the trans_chars and nchars member of the key event.
+ * 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
@@ -947,14 +1019,13 @@ GetTranslatedKey(xkey)
XKeyEvent *xkey;
{
MSG msg;
+ char buf[XMaxTransChars];
- xkey->nchars = 0;
+ xkey->nbytes = 0;
- while (xkey->nchars < XMaxTransChars
+ while ((xkey->nbytes < XMaxTransChars)
&& PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
if ((msg.message == WM_CHAR) || (msg.message == WM_SYSCHAR)) {
- xkey->trans_chars[xkey->nchars] = (char) msg.wParam;
- xkey->nchars++;
GetMessage(&msg, NULL, 0, 0);
/*
@@ -968,6 +1039,9 @@ GetTranslatedKey(xkey)
if ((msg.message == WM_CHAR) && (msg.lParam & 0x20000000)) {
xkey->state = 0;
}
+ buf[xkey->nbytes] = (char) msg.wParam;
+ xkey->trans_chars[xkey->nbytes] = (char) msg.wParam;
+ xkey->nbytes++;
} else {
break;
}
@@ -1084,5 +1158,29 @@ TkWinResendEvent(wndproc, hwnd, eventPtr)
unsigned long
TkpGetMS()
{
- return GetCurrentTime();
+ 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;
}
diff --git a/tk/win/winDumpExts.c b/tk/win/winDumpExts.c
new file mode 100644
index 00000000000..8bc496e01e4
--- /dev/null
+++ b/tk/win/winDumpExts.c
@@ -0,0 +1,503 @@
+/*
+ * winDumpExts.c --
+ * Author: Gordon Chaffee, Scott Stanton
+ *
+ * History: The real functionality of this file was written by
+ * Matt Pietrek in 1993 in his pedump utility. I've
+ * modified it to dump the externals in a bunch of object
+ * files to create a .def file.
+ *
+ * 10/12/95 Modified by Scott Stanton to support Relocatable Object Module
+ * Format files for Borland C++ 4.5.
+ *
+ * Notes: Visual C++ puts an underscore before each exported symbol.
+ * This file removes them. I don't know if this is a problem
+ * this other compilers. If _MSC_VER is defined,
+ * the underscore is removed. If not, it isn't. To get a
+ * full dump of an object file, use the -f option. This can
+ * help determine the something that may be different with a
+ * compiler other than Visual C++.
+ *----------------------------------------------------------------------
+ *
+ * SCCS: @(#) winDumpExts.c 1.11 96/09/18 15:25:11
+ */
+
+#include <windows.h>
+#include <stdio.h>
+#include <string.h>
+#include <process.h>
+
+#ifdef _ALPHA_
+#define e_magic_number IMAGE_FILE_MACHINE_ALPHA
+#else
+#define e_magic_number IMAGE_FILE_MACHINE_I386
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ * GetArgcArgv --
+ *
+ * Break up a line into argc argv
+ *----------------------------------------------------------------------
+ */
+int
+GetArgcArgv(char *s, char **argv)
+{
+ int quote = 0;
+ int argc = 0;
+ char *bp;
+
+ bp = s;
+ while (1) {
+ while (isspace(*bp)) {
+ bp++;
+ }
+ if (*bp == '\n' || *bp == '\0') {
+ *bp = '\0';
+ return argc;
+ }
+ if (*bp == '\"') {
+ quote = 1;
+ bp++;
+ }
+ argv[argc++] = bp;
+
+ while (*bp != '\0') {
+ if (quote) {
+ if (*bp == '\"') {
+ quote = 0;
+ *bp = '\0';
+ bp++;
+ break;
+ }
+ bp++;
+ continue;
+ }
+ if (isspace(*bp)) {
+ *bp = '\0';
+ bp++;
+ break;
+ }
+ bp++;
+ }
+ }
+}
+
+/*
+ * The names of the first group of possible symbol table storage classes
+ */
+char * SzStorageClass1[] = {
+ "NULL","AUTOMATIC","EXTERNAL","STATIC","REGISTER","EXTERNAL_DEF","LABEL",
+ "UNDEFINED_LABEL","MEMBER_OF_STRUCT","ARGUMENT","STRUCT_TAG",
+ "MEMBER_OF_UNION","UNION_TAG","TYPE_DEFINITION","UNDEFINED_STATIC",
+ "ENUM_TAG","MEMBER_OF_ENUM","REGISTER_PARAM","BIT_FIELD"
+};
+
+/*
+ * The names of the second group of possible symbol table storage classes
+ */
+char * SzStorageClass2[] = {
+ "BLOCK","FUNCTION","END_OF_STRUCT","FILE","SECTION","WEAK_EXTERNAL"
+};
+
+/*
+ *----------------------------------------------------------------------
+ * GetSZStorageClass --
+ *
+ * Given a symbol storage class value, return a descriptive
+ * ASCII string
+ *----------------------------------------------------------------------
+ */
+PSTR
+GetSZStorageClass(BYTE storageClass)
+{
+ if ( storageClass <= IMAGE_SYM_CLASS_BIT_FIELD )
+ return SzStorageClass1[storageClass];
+ else if ( (storageClass >= IMAGE_SYM_CLASS_BLOCK)
+ && (storageClass <= IMAGE_SYM_CLASS_WEAK_EXTERNAL) )
+ return SzStorageClass2[storageClass-IMAGE_SYM_CLASS_BLOCK];
+ else
+ return "???";
+}
+
+/*
+ *----------------------------------------------------------------------
+ * GetSectionName --
+ *
+ * Used by DumpSymbolTable, it gives meaningful names to
+ * the non-normal section number.
+ *
+ * Results:
+ * A name is returned in buffer
+ *----------------------------------------------------------------------
+ */
+void
+GetSectionName(WORD section, PSTR buffer, unsigned cbBuffer)
+{
+ char tempbuffer[10];
+
+ switch ( (SHORT)section )
+ {
+ case IMAGE_SYM_UNDEFINED: strcpy(tempbuffer, "UNDEF"); break;
+ case IMAGE_SYM_ABSOLUTE: strcpy(tempbuffer, "ABS "); break;
+ case IMAGE_SYM_DEBUG: strcpy(tempbuffer, "DEBUG"); break;
+ default: wsprintf(tempbuffer, "%-5X", section);
+ }
+
+ strncpy(buffer, tempbuffer, cbBuffer-1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * DumpSymbolTable --
+ *
+ * Dumps a COFF symbol table from an EXE or OBJ. We only use
+ * it to dump tables from OBJs.
+ *----------------------------------------------------------------------
+ */
+void
+DumpSymbolTable(PIMAGE_SYMBOL pSymbolTable, FILE *fout, unsigned cSymbols)
+{
+ unsigned i;
+ PSTR stringTable;
+ char sectionName[10];
+
+ fprintf(fout, "Symbol Table - %X entries (* = auxillary symbol)\n",
+ cSymbols);
+
+ fprintf(fout,
+ "Indx Name Value Section cAux Type Storage\n"
+ "---- -------------------- -------- ---------- ----- ------- --------\n");
+
+ /*
+ * The string table apparently starts right after the symbol table
+ */
+ stringTable = (PSTR)&pSymbolTable[cSymbols];
+
+ for ( i=0; i < cSymbols; i++ ) {
+ fprintf(fout, "%04X ", i);
+ if ( pSymbolTable->N.Name.Short != 0 )
+ fprintf(fout, "%-20.8s", pSymbolTable->N.ShortName);
+ else
+ fprintf(fout, "%-20s", stringTable + pSymbolTable->N.Name.Long);
+
+ fprintf(fout, " %08X", pSymbolTable->Value);
+
+ GetSectionName(pSymbolTable->SectionNumber, sectionName,
+ sizeof(sectionName));
+ fprintf(fout, " sect:%s aux:%X type:%02X st:%s\n",
+ sectionName,
+ pSymbolTable->NumberOfAuxSymbols,
+ pSymbolTable->Type,
+ GetSZStorageClass(pSymbolTable->StorageClass) );
+#if 0
+ if ( pSymbolTable->NumberOfAuxSymbols )
+ DumpAuxSymbols(pSymbolTable);
+#endif
+
+ /*
+ * Take into account any aux symbols
+ */
+ i += pSymbolTable->NumberOfAuxSymbols;
+ pSymbolTable += pSymbolTable->NumberOfAuxSymbols;
+ pSymbolTable++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * DumpExternals --
+ *
+ * Dumps a COFF symbol table from an EXE or OBJ. We only use
+ * it to dump tables from OBJs.
+ *----------------------------------------------------------------------
+ */
+void
+DumpExternals(PIMAGE_SYMBOL pSymbolTable, FILE *fout, unsigned cSymbols)
+{
+ unsigned i;
+ PSTR stringTable;
+ char *s, *f;
+ char symbol[1024];
+
+ /*
+ * The string table apparently starts right after the symbol table
+ */
+ stringTable = (PSTR)&pSymbolTable[cSymbols];
+
+ for ( i=0; i < cSymbols; i++ ) {
+ if (pSymbolTable->SectionNumber > 0 && pSymbolTable->Type == 0x20) {
+ if (pSymbolTable->StorageClass == IMAGE_SYM_CLASS_EXTERNAL) {
+ if (pSymbolTable->N.Name.Short != 0) {
+ strncpy(symbol, pSymbolTable->N.ShortName, 8);
+ symbol[8] = 0;
+ } else {
+ s = stringTable + pSymbolTable->N.Name.Long;
+ strcpy(symbol, s);
+ }
+ s = symbol;
+ f = strchr(s, '@');
+ if (f) {
+ *f = 0;
+ }
+#if defined(_MSC_VER) && defined(_X86_)
+ if (symbol[0] == '_') {
+ s = &symbol[1];
+ }
+#endif
+ if ((stricmp(s, "DllEntryPoint") != 0)
+ && (stricmp(s, "DllMain") != 0)) {
+ fprintf(fout, "\t%s\n", s);
+ }
+ }
+ }
+
+ /*
+ * Take into account any aux symbols
+ */
+ i += pSymbolTable->NumberOfAuxSymbols;
+ pSymbolTable += pSymbolTable->NumberOfAuxSymbols;
+ pSymbolTable++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * DumpObjFile --
+ *
+ * Dump an object file--either a full listing or just the exported
+ * symbols.
+ *----------------------------------------------------------------------
+ */
+void
+DumpObjFile(PIMAGE_FILE_HEADER pImageFileHeader, FILE *fout, int full)
+{
+ PIMAGE_SYMBOL PCOFFSymbolTable;
+ DWORD COFFSymbolCount;
+
+ PCOFFSymbolTable = (PIMAGE_SYMBOL)
+ ((DWORD)pImageFileHeader + pImageFileHeader->PointerToSymbolTable);
+ COFFSymbolCount = pImageFileHeader->NumberOfSymbols;
+
+ if (full) {
+ DumpSymbolTable(PCOFFSymbolTable, fout, COFFSymbolCount);
+ } else {
+ DumpExternals(PCOFFSymbolTable, fout, COFFSymbolCount);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * SkipToNextRecord --
+ *
+ * Skip over the current ROMF record and return the type of the
+ * next record.
+ *----------------------------------------------------------------------
+ */
+
+BYTE
+SkipToNextRecord(BYTE **ppBuffer)
+{
+ int length;
+ (*ppBuffer)++; /* Skip over the type.*/
+ length = *((WORD*)(*ppBuffer))++; /* Retrieve the length. */
+ *ppBuffer += length; /* Skip over the rest. */
+ return **ppBuffer; /* Return the type. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ * DumpROMFObjFile --
+ *
+ * Dump a Relocatable Object Module Format file, displaying only
+ * the exported symbols.
+ *----------------------------------------------------------------------
+ */
+void
+DumpROMFObjFile(LPVOID pBuffer, FILE *fout)
+{
+ BYTE type, length;
+ char symbol[1024], *s;
+
+ while (1) {
+ type = SkipToNextRecord(&(BYTE*)pBuffer);
+ if (type == 0x90) { /* PUBDEF */
+ if (((BYTE*)pBuffer)[4] != 0) {
+ length = ((BYTE*)pBuffer)[5];
+ strncpy(symbol, ((char*)pBuffer) + 6, length);
+ symbol[length] = '\0';
+ s = symbol;
+ if ((stricmp(s, "DllEntryPoint") != 0)
+ && (stricmp(s, "DllMain") != 0)) {
+ if (s[0] == '_') {
+ s++;
+ fprintf(fout, "\t_%s\n\t%s=_%s\n", s, s, s);
+ } else {
+ fprintf(fout, "\t%s\n", s);
+ }
+ }
+ }
+ } else if (type == 0x8B || type == 0x8A) { /* MODEND */
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * DumpFile --
+ *
+ * Open up a file, memory map it, and call the appropriate
+ * dumping routine
+ *----------------------------------------------------------------------
+ */
+void
+DumpFile(LPSTR filename, FILE *fout, int full)
+{
+ HANDLE hFile;
+ HANDLE hFileMapping;
+ LPVOID lpFileBase;
+ PIMAGE_DOS_HEADER dosHeader;
+
+ hFile = CreateFile(filename, GENERIC_READ, FILE_SHARE_READ, NULL,
+ OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
+
+ if (hFile == INVALID_HANDLE_VALUE) {
+ fprintf(stderr, "Couldn't open file with CreateFile()\n");
+ return;
+ }
+
+ hFileMapping = CreateFileMapping(hFile, NULL, PAGE_READONLY, 0, 0, NULL);
+ if (hFileMapping == 0) {
+ CloseHandle(hFile);
+ fprintf(stderr, "Couldn't open file mapping with CreateFileMapping()\n");
+ return;
+ }
+
+ lpFileBase = MapViewOfFile(hFileMapping, FILE_MAP_READ, 0, 0, 0);
+ if (lpFileBase == 0) {
+ CloseHandle(hFileMapping);
+ CloseHandle(hFile);
+ fprintf(stderr, "Couldn't map view of file with MapViewOfFile()\n");
+ return;
+ }
+
+ dosHeader = (PIMAGE_DOS_HEADER)lpFileBase;
+ if (dosHeader->e_magic == IMAGE_DOS_SIGNATURE) {
+#if 0
+ DumpExeFile( dosHeader );
+#else
+ fprintf(stderr, "File is an executable. I don't dump those.\n");
+ return;
+#endif
+ }
+ /* Does it look like a i386 COFF OBJ file??? */
+ else if ((dosHeader->e_magic == e_magic_number)
+ && (dosHeader->e_sp == 0)) {
+ /*
+ * The two tests above aren't what they look like. They're
+ * really checking for IMAGE_FILE_HEADER.Machine == i386 (0x14C)
+ * and IMAGE_FILE_HEADER.SizeOfOptionalHeader == 0;
+ */
+ DumpObjFile((PIMAGE_FILE_HEADER) lpFileBase, fout, full);
+ } else if (*((BYTE *)lpFileBase) == 0x80) {
+ /*
+ * This file looks like it might be a ROMF file.
+ */
+ DumpROMFObjFile(lpFileBase, fout);
+ } else {
+ printf("unrecognized file format\n");
+ }
+ UnmapViewOfFile(lpFileBase);
+ CloseHandle(hFileMapping);
+ CloseHandle(hFile);
+}
+
+void
+main(int argc, char **argv)
+{
+ char *fargv[1000];
+ char cmdline[10000];
+ int i, arg;
+ FILE *fout;
+ int pos;
+ int full = 0;
+ char *outfile = NULL;
+
+ if (argc < 3) {
+ Usage:
+ fprintf(stderr, "Usage: %s ?-o outfile? ?-f(ull)? <dllname> <object filenames> ..\n", argv[0]);
+ exit(1);
+ }
+
+ arg = 1;
+ while (argv[arg][0] == '-') {
+ if (strcmp(argv[arg], "--") == 0) {
+ arg++;
+ break;
+ } else if (strcmp(argv[arg], "-f") == 0) {
+ full = 1;
+ } else if (strcmp(argv[arg], "-o") == 0) {
+ arg++;
+ if (arg == argc) {
+ goto Usage;
+ }
+ outfile = argv[arg];
+ }
+ arg++;
+ }
+ if (arg == argc) {
+ goto Usage;
+ }
+
+ if (outfile) {
+ fout = fopen(outfile, "w+");
+ if (fout == NULL) {
+ fprintf(stderr, "Unable to open \'%s\' for writing:\n",
+ argv[arg]);
+ perror("");
+ exit(1);
+ }
+ } else {
+ fout = stdout;
+ }
+
+ if (! full) {
+ char *dllname = argv[arg];
+ arg++;
+ if (arg == argc) {
+ goto Usage;
+ }
+ fprintf(fout, "LIBRARY %s\n", dllname);
+ fprintf(fout, "EXETYPE WINDOWS\n");
+ fprintf(fout, "CODE PRELOAD MOVEABLE DISCARDABLE\n");
+ fprintf(fout, "DATA PRELOAD MOVEABLE MULTIPLE\n\n");
+ fprintf(fout, "EXPORTS\n");
+ }
+
+ for (; arg < argc; arg++) {
+ if (argv[arg][0] == '@') {
+ FILE *fargs = fopen(&argv[arg][1], "r");
+ if (fargs == NULL) {
+ fprintf(stderr, "Unable to open \'%s\' for reading:\n",
+ argv[arg]);
+ perror("");
+ exit(1);
+ }
+ pos = 0;
+ for (i = 0; i < arg; i++) {
+ strcpy(&cmdline[pos], argv[i]);
+ pos += strlen(&cmdline[pos]) + 1;
+ fargv[i] = argv[i];
+ }
+ fgets(&cmdline[pos], sizeof(cmdline), fargs);
+ fprintf(stderr, "%s\n", &cmdline[pos]);
+ fclose(fargs);
+ i += GetArgcArgv(&cmdline[pos], &fargv[i]);
+ argc = i;
+ argv = fargv;
+ }
+ DumpFile(argv[arg], fout, full);
+ }
+ exit(0);
+}
diff --git a/tk/win/winMain.c b/tk/win/winMain.c
index af989d50948..8cc6b7773e2 100644
--- a/tk/win/winMain.c
+++ b/tk/win/winMain.c
@@ -3,7 +3,8 @@
*
* Main entry point for wish and other Tk-based applications.
*
- * Copyright (c) 1995 Sun Microsystems, 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.
@@ -18,13 +19,13 @@
#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.
*/
-EXTERN void TkConsoleCreate(void);
-EXTERN int TkConsoleInit(Tcl_Interp *interp);
/*
* Forward declarations for procedures defined later in this file:
@@ -34,9 +35,38 @@ static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));
#ifdef TK_TEST
-EXTERN int Tktest_Init(Tcl_Interp *interp);
+extern int Tktest_Init(Tcl_Interp *interp);
#endif /* TK_TEST */
+#ifdef TCL_TEST
+extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+static BOOL consoleRequired = TRUE;
+
+/*
+ * 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
+
/*
*----------------------------------------------------------------------
@@ -62,37 +92,37 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
LPSTR lpszCmdLine;
int nCmdShow;
{
- char **argv, *p;
+ char **argv;
int argc;
- char buffer[MAX_PATH];
+ char buffer[MAX_PATH+1];
+ char *p;
Tcl_SetPanicProc(WishPanic);
/*
- * Set up the default locale to be standard "C" locale so parsing
- * is performed correctly.
- */
-
- setlocale(LC_ALL, "C");
-
-
- /*
* Increase the application queue size from default value of 8.
* At the default value, cross application SendMessage of WM_KILLFOCUS
* will fail because the handler will not be able to do a PostMessage!
* This is only needed for Windows 3.x, since NT dynamically expands
* the queue.
*/
+
SetMessageQueue(64);
/*
* Create the console channels and install them as the standard
- * channels. All I/O will be discarded until TkConsoleInit is
+ * channels. All I/O will be discarded until Tk_CreateConsoleWindow is
* called to attach the console to a text widget.
*/
- TkConsoleCreate();
+ consoleRequired = TRUE;
+ /*
+ * Set up the default locale to be standard "C" locale so parsing
+ * is performed correctly.
+ */
+
+ setlocale(LC_ALL, "C");
setargv(&argc, &argv);
/*
@@ -108,7 +138,11 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
}
}
- Tk_Main(argc, argv, Tcl_AppInit);
+#ifdef TK_LOCAL_MAIN_HOOK
+ TK_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+
+ Tk_Main(argc, argv, TK_LOCAL_APPINIT);
return 1;
}
@@ -124,7 +158,7 @@ WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
@@ -149,9 +183,22 @@ Tcl_AppInit(interp)
* application.
*/
- if (TkConsoleInit(interp) == TCL_ERROR) {
- goto error;
+ if (consoleRequired) {
+ if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
+ goto error;
+ }
+ }
+
+#ifdef TCL_TEST
+ if (Tcltest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
+ (Tcl_PackageInitProc *) NULL);
+ if (TclObjTest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
}
+#endif /* TCL_TEST */
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
@@ -165,7 +212,11 @@ Tcl_AppInit(interp)
return TCL_OK;
error:
- WishPanic(interp->result);
+ 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;
}
@@ -239,7 +290,7 @@ setargv(argcPtr, argvPtr)
char **argv;
int argc, size, inquote, copy, slashes;
- cmdLine = GetCommandLine();
+ cmdLine = GetCommandLine(); /* INTL: BUG */
/*
* Precompute an overly pessimistic guess at the number of arguments
@@ -248,9 +299,9 @@ setargv(argcPtr, argvPtr)
size = 2;
for (p = cmdLine; *p != '\0'; p++) {
- if (isspace(*p)) {
+ if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
size++;
- while (isspace(*p)) {
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
if (*p == '\0') {
@@ -258,8 +309,8 @@ setargv(argcPtr, argvPtr)
}
}
}
- argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)
- + strlen(cmdLine) + 1));
+ argSpace = (char *) Tcl_Alloc(
+ (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
argv = (char **) argSpace;
argSpace += size * sizeof(char *);
size--;
@@ -267,7 +318,7 @@ setargv(argcPtr, argvPtr)
p = cmdLine;
for (argc = 0; argc < size; argc++) {
argv[argc] = arg = argSpace;
- while (isspace(*p)) {
+ while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
p++;
}
if (*p == '\0') {
@@ -301,7 +352,8 @@ setargv(argcPtr, argvPtr)
slashes--;
}
- if ((*p == '\0') || (!inquote && isspace(*p))) {
+ if ((*p == '\0')
+ || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
break;
}
if (copy != 0) {
@@ -319,3 +371,55 @@ setargv(argcPtr, argvPtr)
*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/tk/xlib/X11/X.h b/tk/xlib/X11/X.h
index 55a31335488..a7f6566e237 100644
--- a/tk/xlib/X11/X.h
+++ b/tk/xlib/X11/X.h
@@ -59,7 +59,11 @@ typedef unsigned long VisualID;
typedef unsigned long Time;
-typedef unsigned short KeyCode;
+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
diff --git a/tk/xlib/X11/Xlib.h b/tk/xlib/X11/Xlib.h
index fdf8c2fef99..e8723ddb8f0 100644
--- a/tk/xlib/X11/Xlib.h
+++ b/tk/xlib/X11/Xlib.h
@@ -58,12 +58,10 @@ typedef unsigned long wchar_t;
typedef char *XPointer;
#define Bool int
-/* The Status define conflicts with some Cygwin headers. So on
- Windows we use a typedef instead. */
-#if defined(__WIN32__) || defined(_WIN32)
-typedef int Status;
-#else
+#ifdef MAC_TCL
#define Status int
+#else
+typedef int Status;
#endif
#define True 1
#define False 0
@@ -552,7 +550,7 @@ typedef struct {
Bool same_screen; /* same screen flag */
char trans_chars[XMaxTransChars];
/* translated characters */
- int nchars;
+ int nbytes;
} XKeyEvent;
typedef XKeyEvent XKeyPressedEvent;
typedef XKeyEvent XKeyReleasedEvent;
@@ -1186,584 +1184,6 @@ typedef struct _XIMStatusDrawCallbackStruct {
} data;
} XIMStatusDrawCallbackStruct;
-_XFUNCPROTOBEGIN
-
-extern XFontStruct *XLoadQueryFont(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* name */
-#endif
-);
-
-extern XFontStruct *XQueryFont(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XID /* font_ID */
-#endif
-);
-
-
-extern XTimeCoord *XGetMotionEvents(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Time /* start */,
- Time /* stop */,
- int* /* nevents_return */
-#endif
-);
-
-extern XModifierKeymap *XDeleteModifiermapEntry(
-#if NeedFunctionPrototypes
- XModifierKeymap* /* modmap */,
-#if NeedWidePrototypes
- unsigned int /* keycode_entry */,
-#else
- KeyCode /* keycode_entry */,
-#endif
- int /* modifier */
-#endif
-);
-
-extern XModifierKeymap *XGetModifierMapping(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern XModifierKeymap *XInsertModifiermapEntry(
-#if NeedFunctionPrototypes
- XModifierKeymap* /* modmap */,
-#if NeedWidePrototypes
- unsigned int /* keycode_entry */,
-#else
- KeyCode /* keycode_entry */,
-#endif
- int /* modifier */
-#endif
-);
-
-extern XModifierKeymap *XNewModifiermap(
-#if NeedFunctionPrototypes
- int /* max_keys_per_mod */
-#endif
-);
-
-extern XImage *XCreateImage(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Visual* /* visual */,
- unsigned int /* depth */,
- int /* format */,
- int /* offset */,
- char* /* data */,
- unsigned int /* width */,
- unsigned int /* height */,
- int /* bitmap_pad */,
- int /* bytes_per_line */
-#endif
-);
-extern XImage *XGetImage(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned long /* plane_mask */,
- int /* format */
-#endif
-);
-extern XImage *XGetSubImage(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned long /* plane_mask */,
- int /* format */,
- XImage* /* dest_image */,
- int /* dest_x */,
- int /* dest_y */
-#endif
-);
-
-/*
- * X function declarations.
- */
-extern Display *XOpenDisplay(
-#if NeedFunctionPrototypes
- _Xconst char* /* display_name */
-#endif
-);
-
-extern void XrmInitialize(
-#if NeedFunctionPrototypes
- void
-#endif
-);
-
-extern char *XFetchBytes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* nbytes_return */
-#endif
-);
-extern char *XFetchBuffer(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* nbytes_return */,
- int /* buffer */
-#endif
-);
-extern char *XGetAtomName(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Atom /* atom */
-#endif
-);
-extern char *XGetDefault(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* program */,
- _Xconst char* /* option */
-#endif
-);
-extern char *XDisplayName(
-#if NeedFunctionPrototypes
- _Xconst char* /* string */
-#endif
-);
-extern char *XKeysymToString(
-#if NeedFunctionPrototypes
- KeySym /* keysym */
-#endif
-);
-
-extern int (*XSynchronize(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Bool /* onoff */
-#endif
-))();
-extern int (*XSetAfterFunction(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int (*) (
-#if NeedNestedPrototypes
- Display* /* display */
-#endif
- ) /* procedure */
-#endif
-))();
-extern Atom XInternAtom(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* atom_name */,
- Bool /* only_if_exists */
-#endif
-);
-extern Colormap XCopyColormapAndFree(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */
-#endif
-);
-extern Colormap XCreateColormap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Visual* /* visual */,
- int /* alloc */
-#endif
-);
-extern Cursor XCreatePixmapCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Pixmap /* source */,
- Pixmap /* mask */,
- XColor* /* foreground_color */,
- XColor* /* background_color */,
- unsigned int /* x */,
- unsigned int /* y */
-#endif
-);
-extern Cursor XCreateGlyphCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Font /* source_font */,
- Font /* mask_font */,
- unsigned int /* source_char */,
- unsigned int /* mask_char */,
- XColor* /* foreground_color */,
- XColor* /* background_color */
-#endif
-);
-extern Cursor XCreateFontCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- unsigned int /* shape */
-#endif
-);
-extern Font XLoadFont(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* name */
-#endif
-);
-extern GC XCreateGC(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- unsigned long /* valuemask */,
- XGCValues* /* values */
-#endif
-);
-extern GContext XGContextFromGC(
-#if NeedFunctionPrototypes
- GC /* gc */
-#endif
-);
-extern void XFlushGC(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */
-#endif
-);
-extern Pixmap XCreatePixmap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int /* depth */
-#endif
-);
-extern Pixmap XCreateBitmapFromData(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- _Xconst char* /* data */,
- unsigned int /* width */,
- unsigned int /* height */
-#endif
-);
-extern Pixmap XCreatePixmapFromBitmapData(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- char* /* data */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned long /* fg */,
- unsigned long /* bg */,
- unsigned int /* depth */
-#endif
-);
-extern Window XCreateSimpleWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* parent */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int /* border_width */,
- unsigned long /* border */,
- unsigned long /* background */
-#endif
-);
-extern Window XGetSelectionOwner(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Atom /* selection */
-#endif
-);
-extern Window XCreateWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* parent */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int /* border_width */,
- int /* depth */,
- unsigned int /* class */,
- Visual* /* visual */,
- unsigned long /* valuemask */,
- XSetWindowAttributes* /* attributes */
-#endif
-);
-extern Colormap *XListInstalledColormaps(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int* /* num_return */
-#endif
-);
-extern char **XListFonts(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* pattern */,
- int /* maxnames */,
- int* /* actual_count_return */
-#endif
-);
-extern char **XListFontsWithInfo(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* pattern */,
- int /* maxnames */,
- int* /* count_return */,
- XFontStruct** /* info_return */
-#endif
-);
-extern char **XGetFontPath(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* npaths_return */
-#endif
-);
-extern char **XListExtensions(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* nextensions_return */
-#endif
-);
-extern Atom *XListProperties(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int* /* num_prop_return */
-#endif
-);
-extern XHostAddress *XListHosts(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* nhosts_return */,
- Bool* /* state_return */
-#endif
-);
-extern KeySym XKeycodeToKeysym(
-#if NeedFunctionPrototypes
- Display* /* display */,
-#if NeedWidePrototypes
- unsigned int /* keycode */,
-#else
- KeyCode /* keycode */,
-#endif
- int /* index */
-#endif
-);
-extern KeySym XLookupKeysym(
-#if NeedFunctionPrototypes
- XKeyEvent* /* key_event */,
- int /* index */
-#endif
-);
-extern KeySym *XGetKeyboardMapping(
-#if NeedFunctionPrototypes
- Display* /* display */,
-#if NeedWidePrototypes
- unsigned int /* first_keycode */,
-#else
- KeyCode /* first_keycode */,
-#endif
- int /* keycode_count */,
- int* /* keysyms_per_keycode_return */
-#endif
-);
-extern KeySym XStringToKeysym(
-#if NeedFunctionPrototypes
- _Xconst char* /* string */
-#endif
-);
-extern long XMaxRequestSize(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern long XExtendedMaxRequestSize(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern char *XResourceManagerString(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern char *XScreenResourceString(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern unsigned long XDisplayMotionBufferSize(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern VisualID XVisualIDFromVisual(
-#if NeedFunctionPrototypes
- Visual* /* visual */
-#endif
-);
-
-/* routines for dealing with extensions */
-
-extern XExtCodes *XInitExtension(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* name */
-#endif
-);
-
-extern XExtCodes *XAddExtension(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern XExtData *XFindOnExtensionList(
-#if NeedFunctionPrototypes
- XExtData** /* structure */,
- int /* number */
-#endif
-);
-extern XExtData **XEHeadOfExtensionList(
-#if NeedFunctionPrototypes
- XEDataObject /* object */
-#endif
-);
-
-/* these are routines for which there are also macros */
-extern Window XRootWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern Window XDefaultRootWindow(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern Window XRootWindowOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern Visual *XDefaultVisual(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern Visual *XDefaultVisualOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern GC XDefaultGC(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern GC XDefaultGCOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern unsigned long XBlackPixel(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern unsigned long XWhitePixel(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern unsigned long XAllPlanes(
-#if NeedFunctionPrototypes
- void
-#endif
-);
-extern unsigned long XBlackPixelOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern unsigned long XWhitePixelOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern unsigned long XNextRequest(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern unsigned long XLastKnownRequestProcessed(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern char *XServerVendor(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern char *XDisplayString(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern Colormap XDefaultColormap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern Colormap XDefaultColormapOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern Display *XDisplayOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-extern Screen *XScreenOfDisplay(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-extern Screen *XDefaultScreenOfDisplay(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-extern long XEventMaskOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern int XScreenNumberOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
typedef int (*XErrorHandler) ( /* WARNING, this type not in Xlib spec */
#if NeedFunctionPrototypes
Display* /* display */,
@@ -1771,2541 +1191,11 @@ typedef int (*XErrorHandler) ( /* WARNING, this type not in Xlib spec */
#endif
);
-extern XErrorHandler XSetErrorHandler (
-#if NeedFunctionPrototypes
- XErrorHandler /* handler */
-#endif
-);
-
-
-typedef int (*XIOErrorHandler) ( /* WARNING, this type not in Xlib spec */
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern XIOErrorHandler XSetIOErrorHandler (
-#if NeedFunctionPrototypes
- XIOErrorHandler /* handler */
-#endif
-);
-
-
-extern XPixmapFormatValues *XListPixmapFormats(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* count_return */
-#endif
-);
-extern int *XListDepths(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */,
- int* /* count_return */
-#endif
-);
-
-/* ICCCM routines for things that don't require special include files; */
-/* other declarations are given in Xutil.h */
-extern Status XReconfigureWMWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* screen_number */,
- unsigned int /* mask */,
- XWindowChanges* /* changes */
-#endif
-);
-
-extern Status XGetWMProtocols(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Atom** /* protocols_return */,
- int* /* count_return */
-#endif
-);
-extern Status XSetWMProtocols(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Atom* /* protocols */,
- int /* count */
-#endif
-);
-extern Status XIconifyWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* screen_number */
-#endif
-);
-extern Status XWithdrawWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* screen_number */
-#endif
-);
-extern Status XGetCommand(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- char*** /* argv_return */,
- int* /* argc_return */
-#endif
-);
-extern Status XGetWMColormapWindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window** /* windows_return */,
- int* /* count_return */
-#endif
-);
-extern Status XSetWMColormapWindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window* /* colormap_windows */,
- int /* count */
-#endif
-);
-extern void XFreeStringList(
-#if NeedFunctionPrototypes
- char** /* list */
-#endif
-);
-extern void XSetTransientForHint(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window /* prop_window */
-#endif
-);
-
-/* The following are given in alphabetical order */
-
-extern void XActivateScreenSaver(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XAddHost(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XHostAddress* /* host */
-#endif
-);
-
-extern void XAddHosts(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XHostAddress* /* hosts */,
- int /* num_hosts */
-#endif
-);
-
-extern void XAddToExtensionList(
-#if NeedFunctionPrototypes
- struct _XExtData** /* structure */,
- XExtData* /* ext_data */
-#endif
-);
-
-extern void XAddToSaveSet(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern Status XAllocColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- XColor* /* screen_in_out */
-#endif
-);
-
-extern Status XAllocColorCells(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- Bool /* contig */,
- unsigned long* /* plane_masks_return */,
- unsigned int /* nplanes */,
- unsigned long* /* pixels_return */,
- unsigned int /* npixels */
-#endif
-);
-
-extern Status XAllocColorPlanes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- Bool /* contig */,
- unsigned long* /* pixels_return */,
- int /* ncolors */,
- int /* nreds */,
- int /* ngreens */,
- int /* nblues */,
- unsigned long* /* rmask_return */,
- unsigned long* /* gmask_return */,
- unsigned long* /* bmask_return */
-#endif
-);
-
-extern Status XAllocNamedColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- _Xconst char* /* color_name */,
- XColor* /* screen_def_return */,
- XColor* /* exact_def_return */
-#endif
-);
-
-extern void XAllowEvents(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* event_mode */,
- Time /* time */
-#endif
-);
-
-extern void XAutoRepeatOff(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XAutoRepeatOn(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XBell(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* percent */
-#endif
-);
-
-extern int XBitmapBitOrder(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XBitmapPad(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XBitmapUnit(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XCellsOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern void XChangeActivePointerGrab(
-#if NeedFunctionPrototypes
- Display* /* display */,
- unsigned int /* event_mask */,
- Cursor /* cursor */,
- Time /* time */
-#endif
-);
-
-extern void XChangeGC(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned long /* valuemask */,
- XGCValues* /* values */
-#endif
-);
-
-extern void XChangeKeyboardControl(
-#if NeedFunctionPrototypes
- Display* /* display */,
- unsigned long /* value_mask */,
- XKeyboardControl* /* values */
-#endif
-);
-
-extern void XChangeKeyboardMapping(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* first_keycode */,
- int /* keysyms_per_keycode */,
- KeySym* /* keysyms */,
- int /* num_codes */
-#endif
-);
-
-extern void XChangePointerControl(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Bool /* do_accel */,
- Bool /* do_threshold */,
- int /* accel_numerator */,
- int /* accel_denominator */,
- int /* threshold */
-#endif
-);
-
-extern void XChangeProperty(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Atom /* property */,
- Atom /* type */,
- int /* format */,
- int /* mode */,
- _Xconst unsigned char* /* data */,
- int /* nelements */
-#endif
-);
-
-extern void XChangeSaveSet(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* change_mode */
-#endif
-);
-
-extern void XChangeWindowAttributes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- unsigned long /* valuemask */,
- XSetWindowAttributes* /* attributes */
-#endif
-);
-
-extern Bool XCheckIfEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XEvent* /* event_return */,
- Bool (*) (
-#if NeedNestedPrototypes
- Display* /* display */,
- XEvent* /* event */,
- XPointer /* arg */
-#endif
- ) /* predicate */,
- XPointer /* arg */
-#endif
-);
-
-extern Bool XCheckMaskEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- long /* event_mask */,
- XEvent* /* event_return */
-#endif
-);
-
-extern Bool XCheckTypedEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* event_type */,
- XEvent* /* event_return */
-#endif
-);
-
-extern Bool XCheckTypedWindowEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* event_type */,
- XEvent* /* event_return */
-#endif
-);
-
-extern Bool XCheckWindowEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- long /* event_mask */,
- XEvent* /* event_return */
-#endif
-);
-
-extern void XCirculateSubwindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* direction */
-#endif
-);
-
-extern void XCirculateSubwindowsDown(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XCirculateSubwindowsUp(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XClearArea(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- Bool /* exposures */
-#endif
-);
-
-extern void XClearWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XCloseDisplay(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XConfigureWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- unsigned int /* value_mask */,
- XWindowChanges* /* values */
-#endif
-);
-
-extern int XConnectionNumber(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XConvertSelection(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Atom /* selection */,
- Atom /* target */,
- Atom /* property */,
- Window /* requestor */,
- Time /* time */
-#endif
-);
-
-extern void XCopyArea(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* src */,
- Drawable /* dest */,
- GC /* gc */,
- int /* src_x */,
- int /* src_y */,
- unsigned int /* width */,
- unsigned int /* height */,
- int /* dest_x */,
- int /* dest_y */
-#endif
-);
-
-extern void XCopyGC(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* src */,
- unsigned long /* valuemask */,
- GC /* dest */
-#endif
-);
-
-extern void XCopyPlane(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* src */,
- Drawable /* dest */,
- GC /* gc */,
- int /* src_x */,
- int /* src_y */,
- unsigned int /* width */,
- unsigned int /* height */,
- int /* dest_x */,
- int /* dest_y */,
- unsigned long /* plane */
-#endif
-);
-
-extern int XDefaultDepth(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern int XDefaultDepthOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern int XDefaultScreen(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XDefineCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Cursor /* cursor */
-#endif
-);
-
-extern void XDeleteProperty(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Atom /* property */
-#endif
-);
-
-extern void XDestroyWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XDestroySubwindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern int XDoesBackingStore(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern Bool XDoesSaveUnders(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern void XDisableAccessControl(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-
-extern int XDisplayCells(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern int XDisplayHeight(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern int XDisplayHeightMM(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern void XDisplayKeycodes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* min_keycodes_return */,
- int* /* max_keycodes_return */
-#endif
-);
-
-extern int XDisplayPlanes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern int XDisplayWidth(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern int XDisplayWidthMM(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen_number */
-#endif
-);
-
-extern void XDrawArc(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- int /* angle1 */,
- int /* angle2 */
-#endif
-);
-
-extern void XDrawArcs(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XArc* /* arcs */,
- int /* narcs */
-#endif
-);
-
-extern void XDrawImageString(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- _Xconst char* /* string */,
- int /* length */
-#endif
-);
-
-extern void XDrawImageString16(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- _Xconst XChar2b* /* string */,
- int /* length */
-#endif
-);
-
-extern void XDrawLine(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x1 */,
- int /* y1 */,
- int /* x2 */,
- int /* y2 */
-#endif
-);
-
-extern void XDrawLines(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XPoint* /* points */,
- int /* npoints */,
- int /* mode */
-#endif
-);
-
-extern void XDrawPoint(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */
-#endif
-);
-
-extern void XDrawPoints(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XPoint* /* points */,
- int /* npoints */,
- int /* mode */
-#endif
-);
-
-extern void XDrawRectangle(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */
-#endif
-);
-
-extern void XDrawRectangles(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XRectangle* /* rectangles */,
- int /* nrectangles */
-#endif
-);
-
-extern void XDrawSegments(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XSegment* /* segments */,
- int /* nsegments */
-#endif
-);
-
-extern void XDrawString(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- _Xconst char* /* string */,
- int /* length */
-#endif
-);
-
-extern void XDrawString16(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- _Xconst XChar2b* /* string */,
- int /* length */
-#endif
-);
-
-extern void XDrawText(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- XTextItem* /* items */,
- int /* nitems */
-#endif
-);
-
-extern void XDrawText16(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- XTextItem16* /* items */,
- int /* nitems */
-#endif
-);
-
-extern void XEnableAccessControl(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XEventsQueued(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* mode */
-#endif
-);
-
-extern Status XFetchName(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- char** /* window_name_return */
-#endif
-);
-
-extern void XFillArc(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */,
- int /* angle1 */,
- int /* angle2 */
-#endif
-);
-
-extern void XFillArcs(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XArc* /* arcs */,
- int /* narcs */
-#endif
-);
-
-extern void XFillPolygon(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XPoint* /* points */,
- int /* npoints */,
- int /* shape */,
- int /* mode */
-#endif
-);
-
-extern void XFillRectangle(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */
-#endif
-);
-
-extern void XFillRectangles(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XRectangle* /* rectangles */,
- int /* nrectangles */
-#endif
-);
-
-extern void XFlush(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XForceScreenSaver(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* mode */
-#endif
-);
-
-extern void XFree(
-#if NeedFunctionPrototypes
- void* /* data */
-#endif
-);
-
-extern void XFreeColormap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */
-#endif
-);
-
-extern void XFreeColors(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- unsigned long* /* pixels */,
- int /* npixels */,
- unsigned long /* planes */
-#endif
-);
-
-extern void XFreeCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Cursor /* cursor */
-#endif
-);
-
-extern void XFreeExtensionList(
-#if NeedFunctionPrototypes
- char** /* list */
-#endif
-);
-
-extern void XFreeFont(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XFontStruct* /* font_struct */
-#endif
-);
-
-extern void XFreeFontInfo(
-#if NeedFunctionPrototypes
- char** /* names */,
- XFontStruct* /* free_info */,
- int /* actual_count */
-#endif
-);
-
-extern void XFreeFontNames(
-#if NeedFunctionPrototypes
- char** /* list */
-#endif
-);
-
-extern void XFreeFontPath(
-#if NeedFunctionPrototypes
- char** /* list */
-#endif
-);
-
-extern void XFreeGC(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */
-#endif
-);
-
-extern void XFreeModifiermap(
-#if NeedFunctionPrototypes
- XModifierKeymap* /* modmap */
-#endif
-);
-
-extern void XFreePixmap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Pixmap /* pixmap */
-#endif
-);
-
-extern int XGeometry(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* screen */,
- _Xconst char* /* position */,
- _Xconst char* /* default_position */,
- unsigned int /* bwidth */,
- unsigned int /* fwidth */,
- unsigned int /* fheight */,
- int /* xadder */,
- int /* yadder */,
- int* /* x_return */,
- int* /* y_return */,
- int* /* width_return */,
- int* /* height_return */
-#endif
-);
-
-extern void XGetErrorDatabaseText(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* name */,
- _Xconst char* /* message */,
- _Xconst char* /* default_string */,
- char* /* buffer_return */,
- int /* length */
-#endif
-);
-
-extern void XGetErrorText(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* code */,
- char* /* buffer_return */,
- int /* length */
-#endif
-);
-
-extern Bool XGetFontProperty(
-#if NeedFunctionPrototypes
- XFontStruct* /* font_struct */,
- Atom /* atom */,
- unsigned long* /* value_return */
-#endif
-);
-
-extern Status XGetGCValues(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned long /* valuemask */,
- XGCValues* /* values_return */
-#endif
-);
-
-extern Status XGetGeometry(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- Window* /* root_return */,
- int* /* x_return */,
- int* /* y_return */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */,
- unsigned int* /* border_width_return */,
- unsigned int* /* depth_return */
-#endif
-);
-
-extern Status XGetIconName(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- char** /* icon_name_return */
-#endif
-);
-
-extern void XGetInputFocus(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window* /* focus_return */,
- int* /* revert_to_return */
-#endif
-);
-
-extern void XGetKeyboardControl(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XKeyboardState* /* values_return */
-#endif
-);
-
-extern void XGetPointerControl(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* accel_numerator_return */,
- int* /* accel_denominator_return */,
- int* /* threshold_return */
-#endif
-);
-
-extern int XGetPointerMapping(
-#if NeedFunctionPrototypes
- Display* /* display */,
- unsigned char* /* map_return */,
- int /* nmap */
-#endif
-);
-
-extern void XGetScreenSaver(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int* /* timeout_return */,
- int* /* interval_return */,
- int* /* prefer_blanking_return */,
- int* /* allow_exposures_return */
-#endif
-);
-
-extern Status XGetTransientForHint(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window* /* prop_window_return */
-#endif
-);
-
-extern int XGetWindowProperty(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Atom /* property */,
- long /* long_offset */,
- long /* long_length */,
- Bool /* delete */,
- Atom /* req_type */,
- Atom* /* actual_type_return */,
- int* /* actual_format_return */,
- unsigned long* /* nitems_return */,
- unsigned long* /* bytes_after_return */,
- unsigned char** /* prop_return */
-#endif
-);
-
-extern Status XGetWindowAttributes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- XWindowAttributes* /* window_attributes_return */
-#endif
-);
-
-extern void XGrabButton(
-#if NeedFunctionPrototypes
- Display* /* display */,
- unsigned int /* button */,
- unsigned int /* modifiers */,
- Window /* grab_window */,
- Bool /* owner_events */,
- unsigned int /* event_mask */,
- int /* pointer_mode */,
- int /* keyboard_mode */,
- Window /* confine_to */,
- Cursor /* cursor */
-#endif
-);
-
-extern void XGrabKey(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* keycode */,
- unsigned int /* modifiers */,
- Window /* grab_window */,
- Bool /* owner_events */,
- int /* pointer_mode */,
- int /* keyboard_mode */
-#endif
-);
-
-extern int XGrabKeyboard(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* grab_window */,
- Bool /* owner_events */,
- int /* pointer_mode */,
- int /* keyboard_mode */,
- Time /* time */
-#endif
-);
-
-extern int XGrabPointer(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* grab_window */,
- Bool /* owner_events */,
- unsigned int /* event_mask */,
- int /* pointer_mode */,
- int /* keyboard_mode */,
- Window /* confine_to */,
- Cursor /* cursor */,
- Time /* time */
-#endif
-);
-
-extern void XGrabServer(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XHeightMMOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern int XHeightOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern void XIfEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XEvent* /* event_return */,
- Bool (*) (
-#if NeedNestedPrototypes
- Display* /* display */,
- XEvent* /* event */,
- XPointer /* arg */
-#endif
- ) /* predicate */,
- XPointer /* arg */
-#endif
-);
-
-extern int XImageByteOrder(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XInstallColormap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */
-#endif
-);
-
-extern KeyCode XKeysymToKeycode(
-#if NeedFunctionPrototypes
- Display* /* display */,
- KeySym /* keysym */
-#endif
-);
-
-extern void XKillClient(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XID /* resource */
-#endif
-);
-
-extern unsigned long XLastKnownRequestProcessed(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern Status XLookupColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- _Xconst char* /* color_name */,
- XColor* /* exact_def_return */,
- XColor* /* screen_def_return */
-#endif
-);
-
-extern void XLowerWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XMapRaised(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XMapSubwindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XMapWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XMaskEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- long /* event_mask */,
- XEvent* /* event_return */
-#endif
-);
-
-extern int XMaxCmapsOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern int XMinCmapsOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern void XMoveResizeWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* x */,
- int /* y */,
- unsigned int /* width */,
- unsigned int /* height */
-#endif
-);
-
-extern void XMoveWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- int /* x */,
- int /* y */
-#endif
-);
-
-extern void XNextEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XEvent* /* event_return */
-#endif
-);
-
-extern void XNoOp(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern Status XParseColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- _Xconst char* /* spec */,
- XColor* /* exact_def_return */
-#endif
-);
-
-extern int XParseGeometry(
-#if NeedFunctionPrototypes
- _Xconst char* /* parsestring */,
- int* /* x_return */,
- int* /* y_return */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */
-#endif
-);
-
-extern void XPeekEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XEvent* /* event_return */
-#endif
-);
-
-extern void XPeekIfEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XEvent* /* event_return */,
- Bool (*) (
-#if NeedNestedPrototypes
- Display* /* display */,
- XEvent* /* event */,
- XPointer /* arg */
-#endif
- ) /* predicate */,
- XPointer /* arg */
-#endif
-);
-
-extern int XPending(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XPlanesOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-
-#endif
-);
-
-extern int XProtocolRevision(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern int XProtocolVersion(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-
-extern void XPutBackEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XEvent* /* event */
-#endif
-);
-
-extern void XPutImage(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- XImage* /* image */,
- int /* src_x */,
- int /* src_y */,
- int /* dest_x */,
- int /* dest_y */,
- unsigned int /* width */,
- unsigned int /* height */
-#endif
-);
-
-extern int XQLength(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern Status XQueryBestCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */
-#endif
-);
-
-extern Status XQueryBestSize(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* class */,
- Drawable /* which_screen */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */
-#endif
-);
-
-extern Status XQueryBestStipple(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* which_screen */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */
-#endif
-);
-
-extern Status XQueryBestTile(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* which_screen */,
- unsigned int /* width */,
- unsigned int /* height */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */
-#endif
-);
-
-extern void XQueryColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- XColor* /* def_in_out */
-#endif
-);
-
-extern void XQueryColors(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- XColor* /* defs_in_out */,
- int /* ncolors */
-#endif
-);
-
-extern Bool XQueryExtension(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* name */,
- int* /* major_opcode_return */,
- int* /* first_event_return */,
- int* /* first_error_return */
-#endif
-);
-
-extern void XQueryKeymap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- char [32] /* keys_return */
-#endif
-);
-
-extern Bool XQueryPointer(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window* /* root_return */,
- Window* /* child_return */,
- int* /* root_x_return */,
- int* /* root_y_return */,
- int* /* win_x_return */,
- int* /* win_y_return */,
- unsigned int* /* mask_return */
-#endif
-);
-
-extern void XQueryTextExtents(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XID /* font_ID */,
- _Xconst char* /* string */,
- int /* nchars */,
- int* /* direction_return */,
- int* /* font_ascent_return */,
- int* /* font_descent_return */,
- XCharStruct* /* overall_return */
-#endif
-);
-
-extern void XQueryTextExtents16(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XID /* font_ID */,
- _Xconst XChar2b* /* string */,
- int /* nchars */,
- int* /* direction_return */,
- int* /* font_ascent_return */,
- int* /* font_descent_return */,
- XCharStruct* /* overall_return */
-#endif
-);
-
-extern Status XQueryTree(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window* /* root_return */,
- Window* /* parent_return */,
- Window** /* children_return */,
- unsigned int* /* nchildren_return */
-#endif
-);
-
-extern void XRaiseWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern int XReadBitmapFile(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- _Xconst char* /* filename */,
- unsigned int* /* width_return */,
- unsigned int* /* height_return */,
- Pixmap* /* bitmap_return */,
- int* /* x_hot_return */,
- int* /* y_hot_return */
-#endif
-);
-
-extern void XRebindKeysym(
-#if NeedFunctionPrototypes
- Display* /* display */,
- KeySym /* keysym */,
- KeySym* /* list */,
- int /* mod_count */,
- _Xconst unsigned char* /* string */,
- int /* bytes_string */
-#endif
-);
-
-extern void XRecolorCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Cursor /* cursor */,
- XColor* /* foreground_color */,
- XColor* /* background_color */
-#endif
-);
-
-extern void XRefreshKeyboardMapping(
-#if NeedFunctionPrototypes
- XMappingEvent* /* event_map */
-#endif
-);
-
-extern void XRemoveFromSaveSet(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XRemoveHost(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XHostAddress* /* host */
-#endif
-);
-
-extern void XRemoveHosts(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XHostAddress* /* hosts */,
- int /* num_hosts */
-#endif
-);
-
-extern void XReparentWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Window /* parent */,
- int /* x */,
- int /* y */
-#endif
-);
-
-extern void XResetScreenSaver(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XResizeWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- unsigned int /* width */,
- unsigned int /* height */
-#endif
-);
-
-extern void XRestackWindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window* /* windows */,
- int /* nwindows */
-#endif
-);
-
-extern void XRotateBuffers(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* rotate */
-#endif
-);
-
-extern void XRotateWindowProperties(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Atom* /* properties */,
- int /* num_prop */,
- int /* npositions */
-#endif
-);
-
-extern int XScreenCount(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XSelectInput(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- long /* event_mask */
-#endif
-);
-
-extern Status XSendEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Bool /* propagate */,
- long /* event_mask */,
- XEvent* /* event_send */
-#endif
-);
-
-extern void XSetAccessControl(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* mode */
-#endif
-);
-
-extern void XSetArcMode(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* arc_mode */
-#endif
-);
-
-extern void XSetBackground(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned long /* background */
-#endif
-);
-
-extern void XSetClipMask(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- Pixmap /* pixmap */
-#endif
-);
-
-extern void XSetClipOrigin(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* clip_x_origin */,
- int /* clip_y_origin */
-#endif
-);
-
-extern void XSetClipRectangles(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* clip_x_origin */,
- int /* clip_y_origin */,
- XRectangle* /* rectangles */,
- int /* n */,
- int /* ordering */
-#endif
-);
-
-extern void XSetCloseDownMode(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* close_mode */
-#endif
-);
-
-extern void XSetCommand(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- char** /* argv */,
- int /* argc */
-#endif
-);
-
-extern void XSetDashes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* dash_offset */,
- _Xconst char* /* dash_list */,
- int /* n */
-#endif
-);
-
-extern void XSetFillRule(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* fill_rule */
-#endif
-);
-
-extern void XSetFillStyle(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* fill_style */
-#endif
-);
-
-extern void XSetFont(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- Font /* font */
-#endif
-);
-
-extern void XSetFontPath(
-#if NeedFunctionPrototypes
- Display* /* display */,
- char** /* directories */,
- int /* ndirs */
-#endif
-);
-
-extern void XSetForeground(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned long /* foreground */
-#endif
-);
-
-extern void XSetFunction(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* function */
-#endif
-);
-
-extern void XSetGraphicsExposures(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- Bool /* graphics_exposures */
-#endif
-);
-
-extern void XSetIconName(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- _Xconst char* /* icon_name */
-#endif
-);
-
-extern void XSetInputFocus(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* focus */,
- int /* revert_to */,
- Time /* time */
-#endif
-);
-
-extern void XSetLineAttributes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned int /* line_width */,
- int /* line_style */,
- int /* cap_style */,
- int /* join_style */
-#endif
-);
-
-extern int XSetModifierMapping(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XModifierKeymap* /* modmap */
-#endif
-);
-
-extern void XSetPlaneMask(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned long /* plane_mask */
-#endif
-);
-
-extern int XSetPointerMapping(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst unsigned char* /* map */,
- int /* nmap */
-#endif
-);
-
-extern void XSetScreenSaver(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* timeout */,
- int /* interval */,
- int /* prefer_blanking */,
- int /* allow_exposures */
-#endif
-);
-
-extern void XSetSelectionOwner(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Atom /* selection */,
- Window /* owner */,
- Time /* time */
-#endif
-);
-
-extern void XSetState(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- unsigned long /* foreground */,
- unsigned long /* background */,
- int /* function */,
- unsigned long /* plane_mask */
-#endif
-);
-
-extern void XSetStipple(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- Pixmap /* stipple */
-#endif
-);
-
-extern void XSetSubwindowMode(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* subwindow_mode */
-#endif
-);
-
-extern void XSetTSOrigin(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- int /* ts_x_origin */,
- int /* ts_y_origin */
-#endif
-);
-
-extern void XSetTile(
-#if NeedFunctionPrototypes
- Display* /* display */,
- GC /* gc */,
- Pixmap /* tile */
-#endif
-);
-
-extern void XSetWindowBackground(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- unsigned long /* background_pixel */
-#endif
-);
-
-extern void XSetWindowBackgroundPixmap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Pixmap /* background_pixmap */
-#endif
-);
-
-extern void XSetWindowBorder(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- unsigned long /* border_pixel */
-#endif
-);
-
-extern void XSetWindowBorderPixmap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Pixmap /* border_pixmap */
-#endif
-);
-
-extern void XSetWindowBorderWidth(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- unsigned int /* width */
-#endif
-);
-
-extern void XSetWindowColormap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- Colormap /* colormap */
-#endif
-);
-
-extern void XStoreBuffer(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* bytes */,
- int /* nbytes */,
- int /* buffer */
-#endif
-);
-
-extern void XStoreBytes(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* bytes */,
- int /* nbytes */
-#endif
-);
-
-extern void XStoreColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- XColor* /* color */
-#endif
-);
-
-extern void XStoreColors(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- XColor* /* color */,
- int /* ncolors */
-#endif
-);
-
-extern void XStoreName(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- _Xconst char* /* window_name */
-#endif
-);
-
-extern void XStoreNamedColor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */,
- _Xconst char* /* color */,
- unsigned long /* pixel */,
- int /* flags */
-#endif
-);
-
-extern void XSync(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Bool /* discard */
-#endif
-);
-
-extern void XTextExtents(
-#if NeedFunctionPrototypes
- XFontStruct* /* font_struct */,
- _Xconst char* /* string */,
- int /* nchars */,
- int* /* direction_return */,
- int* /* font_ascent_return */,
- int* /* font_descent_return */,
- XCharStruct* /* overall_return */
-#endif
-);
-
-extern void XTextExtents16(
-#if NeedFunctionPrototypes
- XFontStruct* /* font_struct */,
- _Xconst XChar2b* /* string */,
- int /* nchars */,
- int* /* direction_return */,
- int* /* font_ascent_return */,
- int* /* font_descent_return */,
- XCharStruct* /* overall_return */
-#endif
-);
-
-extern int XTextWidth(
-#if NeedFunctionPrototypes
- XFontStruct* /* font_struct */,
- _Xconst char* /* string */,
- int /* count */
-#endif
-);
-
-extern int XTextWidth16(
-#if NeedFunctionPrototypes
- XFontStruct* /* font_struct */,
- _Xconst XChar2b* /* string */,
- int /* count */
-#endif
-);
-
-extern Bool XTranslateCoordinates(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* src_w */,
- Window /* dest_w */,
- int /* src_x */,
- int /* src_y */,
- int* /* dest_x_return */,
- int* /* dest_y_return */,
- Window* /* child_return */
-#endif
-);
-
-extern void XUndefineCursor(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XUngrabButton(
-#if NeedFunctionPrototypes
- Display* /* display */,
- unsigned int /* button */,
- unsigned int /* modifiers */,
- Window /* grab_window */
-#endif
-);
-
-extern void XUngrabKey(
-#if NeedFunctionPrototypes
- Display* /* display */,
- int /* keycode */,
- unsigned int /* modifiers */,
- Window /* grab_window */
-#endif
-);
-
-extern void XUngrabKeyboard(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Time /* time */
-#endif
-);
-
-extern void XUngrabPointer(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Time /* time */
-#endif
-);
-
-extern void XUngrabServer(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XUninstallColormap(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Colormap /* colormap */
-#endif
-);
-
-extern void XUnloadFont(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Font /* font */
-#endif
-);
-
-extern void XUnmapSubwindows(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern void XUnmapWindow(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */
-#endif
-);
-
-extern int XVendorRelease(
-#if NeedFunctionPrototypes
- Display* /* display */
-#endif
-);
-
-extern void XWarpPointer(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* src_w */,
- Window /* dest_w */,
- int /* src_x */,
- int /* src_y */,
- unsigned int /* src_width */,
- unsigned int /* src_height */,
- int /* dest_x */,
- int /* dest_y */
-#endif
-);
-
-extern int XWidthMMOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern int XWidthOfScreen(
-#if NeedFunctionPrototypes
- Screen* /* screen */
-#endif
-);
-
-extern void XWindowEvent(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- long /* event_mask */,
- XEvent* /* event_return */
-#endif
-);
-
-extern int XWriteBitmapFile(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* filename */,
- Pixmap /* bitmap */,
- unsigned int /* width */,
- unsigned int /* height */,
- int /* x_hot */,
- int /* y_hot */
-#endif
-);
-
-extern Bool XSupportsLocale(
-#if NeedFunctionPrototypes
- void
-#endif
-);
-
-extern char *XSetLocaleModifiers(
-#if NeedFunctionPrototypes
- _Xconst char* /* modifier_list */
-#endif
-);
-
-extern XFontSet XCreateFontSet(
-#if NeedFunctionPrototypes
- Display* /* display */,
- _Xconst char* /* base_font_name_list */,
- char*** /* missing_charset_list */,
- int* /* missing_charset_count */,
- char** /* def_string */
-#endif
-);
-
-extern void XFreeFontSet(
-#if NeedFunctionPrototypes
- Display* /* display */,
- XFontSet /* font_set */
-#endif
-);
-
-extern int XFontsOfFontSet(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- XFontStruct*** /* font_struct_list */,
- char*** /* font_name_list */
-#endif
-);
-
-extern char *XBaseFontNameListOfFontSet(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */
-#endif
-);
-
-extern char *XLocaleOfFontSet(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */
-#endif
-);
-
-extern Bool XContextDependentDrawing(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */
-#endif
-);
-
-extern XFontSetExtents *XExtentsOfFontSet(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */
-#endif
-);
-
-extern int XmbTextEscapement(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- _Xconst char* /* text */,
- int /* bytes_text */
-#endif
-);
-
-extern int XwcTextEscapement(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- wchar_t* /* text */,
- int /* num_wchars */
-#endif
-);
-
-extern int XmbTextExtents(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- _Xconst char* /* text */,
- int /* bytes_text */,
- XRectangle* /* overall_ink_return */,
- XRectangle* /* overall_logical_return */
-#endif
-);
-
-extern int XwcTextExtents(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- wchar_t* /* text */,
- int /* num_wchars */,
- XRectangle* /* overall_ink_return */,
- XRectangle* /* overall_logical_return */
-#endif
-);
-
-extern Status XmbTextPerCharExtents(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- _Xconst char* /* text */,
- int /* bytes_text */,
- XRectangle* /* ink_extents_buffer */,
- XRectangle* /* logical_extents_buffer */,
- int /* buffer_size */,
- int* /* num_chars */,
- XRectangle* /* overall_ink_return */,
- XRectangle* /* overall_logical_return */
-#endif
-);
-
-extern Status XwcTextPerCharExtents(
-#if NeedFunctionPrototypes
- XFontSet /* font_set */,
- wchar_t* /* text */,
- int /* num_wchars */,
- XRectangle* /* ink_extents_buffer */,
- XRectangle* /* logical_extents_buffer */,
- int /* buffer_size */,
- int* /* num_chars */,
- XRectangle* /* overall_ink_return */,
- XRectangle* /* overall_logical_return */
-#endif
-);
-
-extern void XmbDrawText(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- XmbTextItem* /* text_items */,
- int /* nitems */
-#endif
-);
-
-extern void XwcDrawText(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- XwcTextItem* /* text_items */,
- int /* nitems */
-#endif
-);
-
-extern void XmbDrawString(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- XFontSet /* font_set */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- _Xconst char* /* text */,
- int /* bytes_text */
-#endif
-);
-
-extern void XwcDrawString(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- XFontSet /* font_set */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- wchar_t* /* text */,
- int /* num_wchars */
-#endif
-);
-
-extern void XmbDrawImageString(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- XFontSet /* font_set */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- _Xconst char* /* text */,
- int /* bytes_text */
-#endif
-);
-
-extern void XwcDrawImageString(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Drawable /* d */,
- XFontSet /* font_set */,
- GC /* gc */,
- int /* x */,
- int /* y */,
- wchar_t* /* text */,
- int /* num_wchars */
-#endif
-);
-
-extern XIM XOpenIM(
-#if NeedFunctionPrototypes
- Display* /* dpy */,
- struct _XrmHashBucketRec* /* rdb */,
- char* /* res_name */,
- char* /* res_class */
-#endif
-);
-
-extern Status XCloseIM(
-#if NeedFunctionPrototypes
- XIM /* im */
-#endif
-);
-
-extern char *XGetIMValues(
-#if NeedVarargsPrototypes
- XIM /* im */, ...
-#endif
-);
-
-extern Display *XDisplayOfIM(
-#if NeedFunctionPrototypes
- XIM /* im */
-#endif
-);
-
-extern char *XLocaleOfIM(
-#if NeedFunctionPrototypes
- XIM /* im*/
-#endif
-);
-
-extern XIC XCreateIC(
-#if NeedVarargsPrototypes
- XIM /* im */, ...
-#endif
-);
-
-extern void XDestroyIC(
-#if NeedFunctionPrototypes
- XIC /* ic */
-#endif
-);
-
-extern void XSetICFocus(
-#if NeedFunctionPrototypes
- XIC /* ic */
-#endif
-);
-
-extern void XUnsetICFocus(
-#if NeedFunctionPrototypes
- XIC /* ic */
-#endif
-);
-
-extern wchar_t *XwcResetIC(
-#if NeedFunctionPrototypes
- XIC /* ic */
-#endif
-);
-
-extern char *XmbResetIC(
-#if NeedFunctionPrototypes
- XIC /* ic */
-#endif
-);
-
-extern char *XSetICValues(
-#if NeedVarargsPrototypes
- XIC /* ic */, ...
-#endif
-);
-
-extern char *XGetICValues(
-#if NeedVarargsPrototypes
- XIC /* ic */, ...
-#endif
-);
-
-extern XIM XIMOfIC(
-#if NeedFunctionPrototypes
- XIC /* ic */
-#endif
-);
+_XFUNCPROTOBEGIN
-extern Bool XFilterEvent(
-#if NeedFunctionPrototypes
- XEvent* /* event */,
- Window /* window */
-#endif
-);
-extern int XmbLookupString(
-#if NeedFunctionPrototypes
- XIC /* ic */,
- XKeyPressedEvent* /* event */,
- char* /* buffer_return */,
- int /* bytes_buffer */,
- KeySym* /* keysym_return */,
- Status* /* status_return */
-#endif
-);
-extern int XwcLookupString(
-#if NeedFunctionPrototypes
- XIC /* ic */,
- XKeyPressedEvent* /* event */,
- wchar_t* /* buffer_return */,
- int /* wchars_buffer */,
- KeySym* /* keysym_return */,
- Status* /* status_return */
-#endif
-);
-
-extern XVaNestedList XVaCreateNestedList(
-#if NeedVarargsPrototypes
- int /*unused*/, ...
-#endif
-);
+#include "tkIntXlibDecls.h"
_XFUNCPROTOEND
diff --git a/tk/xlib/X11/Xutil.h b/tk/xlib/X11/Xutil.h
index 63328509c69..f6c0a36788f 100644
--- a/tk/xlib/X11/Xutil.h
+++ b/tk/xlib/X11/Xutil.h
@@ -448,14 +448,6 @@ extern Status XGetTextProperty(
#endif
);
-extern XVisualInfo *XGetVisualInfo(
-#if NeedFunctionPrototypes
- Display* /* display */,
- long /* vinfo_mask */,
- XVisualInfo* /* vinfo_template */,
- int* /* nitems_return */
-#endif
-);
extern Status XGetWMClientMachine(
#if NeedFunctionPrototypes
@@ -652,14 +644,6 @@ extern void XSetTextProperty(
#endif
);
-extern void XSetWMClientMachine(
-#if NeedFunctionPrototypes
- Display* /* display */,
- Window /* w */,
- XTextProperty* /* text_prop */
-#endif
-);
-
extern void XSetWMHints(
#if NeedFunctionPrototypes
Display* /* display */,
@@ -762,14 +746,6 @@ extern void XShrinkRegion(
#endif
);
-extern Status XStringListToTextProperty(
-#if NeedFunctionPrototypes
- char** /* list */,
- int /* count */,
- XTextProperty* /* text_prop_return */
-#endif
-);
-
extern void XSubtractRegion(
#if NeedFunctionPrototypes
Region /* sra */,
diff --git a/tk/xlib/xbytes.h b/tk/xlib/xbytes.h
index fb2ee851c43..bc22e892be1 100644
--- a/tk/xlib/xbytes.h
+++ b/tk/xlib/xbytes.h
@@ -56,3 +56,4 @@ static unsigned char xBitReverseTable[256] = {
};
#endif /* _XBYTES */
+
diff --git a/tk/xlib/xcolors.c b/tk/xlib/xcolors.c
index 5335c54cfdb..85341dfa676 100644
--- a/tk/xlib/xcolors.c
+++ b/tk/xlib/xcolors.c
@@ -854,9 +854,9 @@ FindColor(name, colorPtr)
if (l > u) {
return 0;
}
- colorPtr->red = xColors[i].red << 8;
- colorPtr->green = xColors[i].green << 8;
- colorPtr->blue = xColors[i].blue << 8;
+ 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;
}
@@ -896,9 +896,12 @@ XParseColor(display, map, spec, colorPtr)
if (sscanf(spec+1, fmt, &red, &green, &blue) != 3) {
return 0;
}
- colorPtr->red = ((unsigned short) red) << (4 * (4 - i));
- colorPtr->green = ((unsigned short) green) << (4 * (4 - i));
- colorPtr->blue = ((unsigned short) blue) << (4 * (4 - i));
+ 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;
@@ -909,3 +912,5 @@ XParseColor(display, map, spec, colorPtr)
colorPtr->pad = 0;
return 1;
}
+
+
diff --git a/tk/xlib/xcolors.h b/tk/xlib/xcolors.h
new file mode 100644
index 00000000000..ad62d18102f
--- /dev/null
+++ b/tk/xlib/xcolors.h
@@ -0,0 +1,771 @@
+/*
+ * xcolors.h --
+ *
+ * This file defines the xColors array which contains RGB values
+ * for the X color names.
+ *
+ * Copyright (c) 1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) xcolors.h 1.1 95/02/08 11:29:12
+ */
+
+#ifndef _XCOLORS
+#define _XCOLORS
+
+/*
+ * Define X color names structure.
+ */
+
+typedef struct {
+ unsigned char red;
+ unsigned char green;
+ unsigned char blue;
+ char *name;
+} XColorEntry;
+
+static XColorEntry xColors[] = {
+ 255, 250, 250, "snow",
+ 248, 248, 255, "ghost white",
+ 248, 248, 255, "GhostWhite",
+ 245, 245, 245, "white smoke",
+ 245, 245, 245, "WhiteSmoke",
+ 220, 220, 220, "gainsboro",
+ 255, 250, 240, "floral white",
+ 255, 250, 240, "FloralWhite",
+ 253, 245, 230, "old lace",
+ 253, 245, 230, "OldLace",
+ 250, 240, 230, "linen",
+ 250, 235, 215, "antique white",
+ 250, 235, 215, "AntiqueWhite",
+ 255, 239, 213, "papaya whip",
+ 255, 239, 213, "PapayaWhip",
+ 255, 235, 205, "blanched almond",
+ 255, 235, 205, "BlanchedAlmond",
+ 255, 228, 196, "bisque",
+ 255, 218, 185, "peach puff",
+ 255, 218, 185, "PeachPuff",
+ 255, 222, 173, "navajo white",
+ 255, 222, 173, "NavajoWhite",
+ 255, 228, 181, "moccasin",
+ 255, 248, 220, "cornsilk",
+ 255, 255, 240, "ivory",
+ 255, 250, 205, "lemon chiffon",
+ 255, 250, 205, "LemonChiffon",
+ 255, 245, 238, "seashell",
+ 240, 255, 240, "honeydew",
+ 245, 255, 250, "mint cream",
+ 245, 255, 250, "MintCream",
+ 240, 255, 255, "azure",
+ 240, 248, 255, "alice blue",
+ 240, 248, 255, "AliceBlue",
+ 230, 230, 250, "lavender",
+ 255, 240, 245, "lavender blush",
+ 255, 240, 245, "LavenderBlush",
+ 255, 228, 225, "misty rose",
+ 255, 228, 225, "MistyRose",
+ 255, 255, 255, "white",
+ 0, 0, 0, "black",
+ 47, 79, 79, "dark slate gray",
+ 47, 79, 79, "DarkSlateGray",
+ 47, 79, 79, "dark slate grey",
+ 47, 79, 79, "DarkSlateGrey",
+ 105, 105, 105, "dim gray",
+ 105, 105, 105, "DimGray",
+ 105, 105, 105, "dim grey",
+ 105, 105, 105, "DimGrey",
+ 112, 128, 144, "slate gray",
+ 112, 128, 144, "SlateGray",
+ 112, 128, 144, "slate grey",
+ 112, 128, 144, "SlateGrey",
+ 119, 136, 153, "light slate gray",
+ 119, 136, 153, "LightSlateGray",
+ 119, 136, 153, "light slate grey",
+ 119, 136, 153, "LightSlateGrey",
+ 190, 190, 190, "gray",
+ 190, 190, 190, "grey",
+ 211, 211, 211, "light grey",
+ 211, 211, 211, "LightGrey",
+ 211, 211, 211, "light gray",
+ 211, 211, 211, "LightGray",
+ 25, 25, 112, "midnight blue",
+ 25, 25, 112, "MidnightBlue",
+ 0, 0, 128, "navy",
+ 0, 0, 128, "navy blue",
+ 0, 0, 128, "NavyBlue",
+ 100, 149, 237, "cornflower blue",
+ 100, 149, 237, "CornflowerBlue",
+ 72, 61, 139, "dark slate blue",
+ 72, 61, 139, "DarkSlateBlue",
+ 106, 90, 205, "slate blue",
+ 106, 90, 205, "SlateBlue",
+ 123, 104, 238, "medium slate blue",
+ 123, 104, 238, "MediumSlateBlue",
+ 132, 112, 255, "light slate blue",
+ 132, 112, 255, "LightSlateBlue",
+ 0, 0, 205, "medium blue",
+ 0, 0, 205, "MediumBlue",
+ 65, 105, 225, "royal blue",
+ 65, 105, 225, "RoyalBlue",
+ 0, 0, 255, "blue",
+ 30, 144, 255, "dodger blue",
+ 30, 144, 255, "DodgerBlue",
+ 0, 191, 255, "deep sky blue",
+ 0, 191, 255, "DeepSkyBlue",
+ 135, 206, 235, "sky blue",
+ 135, 206, 235, "SkyBlue",
+ 135, 206, 250, "light sky blue",
+ 135, 206, 250, "LightSkyBlue",
+ 70, 130, 180, "steel blue",
+ 70, 130, 180, "SteelBlue",
+ 176, 196, 222, "light steel blue",
+ 176, 196, 222, "LightSteelBlue",
+ 173, 216, 230, "light blue",
+ 173, 216, 230, "LightBlue",
+ 176, 224, 230, "powder blue",
+ 176, 224, 230, "PowderBlue",
+ 175, 238, 238, "pale turquoise",
+ 175, 238, 238, "PaleTurquoise",
+ 0, 206, 209, "dark turquoise",
+ 0, 206, 209, "DarkTurquoise",
+ 72, 209, 204, "medium turquoise",
+ 72, 209, 204, "MediumTurquoise",
+ 64, 224, 208, "turquoise",
+ 0, 255, 255, "cyan",
+ 224, 255, 255, "light cyan",
+ 224, 255, 255, "LightCyan",
+ 95, 158, 160, "cadet blue",
+ 95, 158, 160, "CadetBlue",
+ 102, 205, 170, "medium aquamarine",
+ 102, 205, 170, "MediumAquamarine",
+ 127, 255, 212, "aquamarine",
+ 0, 100, 0, "dark green",
+ 0, 100, 0, "DarkGreen",
+ 85, 107, 47, "dark olive green",
+ 85, 107, 47, "DarkOliveGreen",
+ 143, 188, 143, "dark sea green",
+ 143, 188, 143, "DarkSeaGreen",
+ 46, 139, 87, "sea green",
+ 46, 139, 87, "SeaGreen",
+ 60, 179, 113, "medium sea green",
+ 60, 179, 113, "MediumSeaGreen",
+ 32, 178, 170, "light sea green",
+ 32, 178, 170, "LightSeaGreen",
+ 152, 251, 152, "pale green",
+ 152, 251, 152, "PaleGreen",
+ 0, 255, 127, "spring green",
+ 0, 255, 127, "SpringGreen",
+ 124, 252, 0, "lawn green",
+ 124, 252, 0, "LawnGreen",
+ 0, 255, 0, "green",
+ 127, 255, 0, "chartreuse",
+ 0, 250, 154, "medium spring green",
+ 0, 250, 154, "MediumSpringGreen",
+ 173, 255, 47, "green yellow",
+ 173, 255, 47, "GreenYellow",
+ 50, 205, 50, "lime green",
+ 50, 205, 50, "LimeGreen",
+ 154, 205, 50, "yellow green",
+ 154, 205, 50, "YellowGreen",
+ 34, 139, 34, "forest green",
+ 34, 139, 34, "ForestGreen",
+ 107, 142, 35, "olive drab",
+ 107, 142, 35, "OliveDrab",
+ 189, 183, 107, "dark khaki",
+ 189, 183, 107, "DarkKhaki",
+ 240, 230, 140, "khaki",
+ 238, 232, 170, "pale goldenrod",
+ 238, 232, 170, "PaleGoldenrod",
+ 250, 250, 210, "light goldenrod yellow",
+ 250, 250, 210, "LightGoldenrodYellow",
+ 255, 255, 224, "light yellow",
+ 255, 255, 224, "LightYellow",
+ 255, 255, 0, "yellow",
+ 255, 215, 0, "gold",
+ 238, 221, 130, "light goldenrod",
+ 238, 221, 130, "LightGoldenrod",
+ 218, 165, 32, "goldenrod",
+ 184, 134, 11, "dark goldenrod",
+ 184, 134, 11, "DarkGoldenrod",
+ 188, 143, 143, "rosy brown",
+ 188, 143, 143, "RosyBrown",
+ 205, 92, 92, "indian red",
+ 205, 92, 92, "IndianRed",
+ 139, 69, 19, "saddle brown",
+ 139, 69, 19, "SaddleBrown",
+ 160, 82, 45, "sienna",
+ 205, 133, 63, "peru",
+ 222, 184, 135, "burlywood",
+ 245, 245, 220, "beige",
+ 245, 222, 179, "wheat",
+ 244, 164, 96, "sandy brown",
+ 244, 164, 96, "SandyBrown",
+ 210, 180, 140, "tan",
+ 210, 105, 30, "chocolate",
+ 178, 34, 34, "firebrick",
+ 165, 42, 42, "brown",
+ 233, 150, 122, "dark salmon",
+ 233, 150, 122, "DarkSalmon",
+ 250, 128, 114, "salmon",
+ 255, 160, 122, "light salmon",
+ 255, 160, 122, "LightSalmon",
+ 255, 165, 0, "orange",
+ 255, 140, 0, "dark orange",
+ 255, 140, 0, "DarkOrange",
+ 255, 127, 80, "coral",
+ 240, 128, 128, "light coral",
+ 240, 128, 128, "LightCoral",
+ 255, 99, 71, "tomato",
+ 255, 69, 0, "orange red",
+ 255, 69, 0, "OrangeRed",
+ 255, 0, 0, "red",
+ 255, 105, 180, "hot pink",
+ 255, 105, 180, "HotPink",
+ 255, 20, 147, "deep pink",
+ 255, 20, 147, "DeepPink",
+ 255, 192, 203, "pink",
+ 255, 182, 193, "light pink",
+ 255, 182, 193, "LightPink",
+ 219, 112, 147, "pale violet red",
+ 219, 112, 147, "PaleVioletRed",
+ 176, 48, 96, "maroon",
+ 199, 21, 133, "medium violet red",
+ 199, 21, 133, "MediumVioletRed",
+ 208, 32, 144, "violet red",
+ 208, 32, 144, "VioletRed",
+ 255, 0, 255, "magenta",
+ 238, 130, 238, "violet",
+ 221, 160, 221, "plum",
+ 218, 112, 214, "orchid",
+ 186, 85, 211, "medium orchid",
+ 186, 85, 211, "MediumOrchid",
+ 153, 50, 204, "dark orchid",
+ 153, 50, 204, "DarkOrchid",
+ 148, 0, 211, "dark violet",
+ 148, 0, 211, "DarkViolet",
+ 138, 43, 226, "blue violet",
+ 138, 43, 226, "BlueViolet",
+ 160, 32, 240, "purple",
+ 147, 112, 219, "medium purple",
+ 147, 112, 219, "MediumPurple",
+ 216, 191, 216, "thistle",
+ 255, 250, 250, "snow1",
+ 238, 233, 233, "snow2",
+ 205, 201, 201, "snow3",
+ 139, 137, 137, "snow4",
+ 255, 245, 238, "seashell1",
+ 238, 229, 222, "seashell2",
+ 205, 197, 191, "seashell3",
+ 139, 134, 130, "seashell4",
+ 255, 239, 219, "AntiqueWhite1",
+ 238, 223, 204, "AntiqueWhite2",
+ 205, 192, 176, "AntiqueWhite3",
+ 139, 131, 120, "AntiqueWhite4",
+ 255, 228, 196, "bisque1",
+ 238, 213, 183, "bisque2",
+ 205, 183, 158, "bisque3",
+ 139, 125, 107, "bisque4",
+ 255, 218, 185, "PeachPuff1",
+ 238, 203, 173, "PeachPuff2",
+ 205, 175, 149, "PeachPuff3",
+ 139, 119, 101, "PeachPuff4",
+ 255, 222, 173, "NavajoWhite1",
+ 238, 207, 161, "NavajoWhite2",
+ 205, 179, 139, "NavajoWhite3",
+ 139, 121, 94, "NavajoWhite4",
+ 255, 250, 205, "LemonChiffon1",
+ 238, 233, 191, "LemonChiffon2",
+ 205, 201, 165, "LemonChiffon3",
+ 139, 137, 112, "LemonChiffon4",
+ 255, 248, 220, "cornsilk1",
+ 238, 232, 205, "cornsilk2",
+ 205, 200, 177, "cornsilk3",
+ 139, 136, 120, "cornsilk4",
+ 255, 255, 240, "ivory1",
+ 238, 238, 224, "ivory2",
+ 205, 205, 193, "ivory3",
+ 139, 139, 131, "ivory4",
+ 240, 255, 240, "honeydew1",
+ 224, 238, 224, "honeydew2",
+ 193, 205, 193, "honeydew3",
+ 131, 139, 131, "honeydew4",
+ 255, 240, 245, "LavenderBlush1",
+ 238, 224, 229, "LavenderBlush2",
+ 205, 193, 197, "LavenderBlush3",
+ 139, 131, 134, "LavenderBlush4",
+ 255, 228, 225, "MistyRose1",
+ 238, 213, 210, "MistyRose2",
+ 205, 183, 181, "MistyRose3",
+ 139, 125, 123, "MistyRose4",
+ 240, 255, 255, "azure1",
+ 224, 238, 238, "azure2",
+ 193, 205, 205, "azure3",
+ 131, 139, 139, "azure4",
+ 131, 111, 255, "SlateBlue1",
+ 122, 103, 238, "SlateBlue2",
+ 105, 89, 205, "SlateBlue3",
+ 71, 60, 139, "SlateBlue4",
+ 72, 118, 255, "RoyalBlue1",
+ 67, 110, 238, "RoyalBlue2",
+ 58, 95, 205, "RoyalBlue3",
+ 39, 64, 139, "RoyalBlue4",
+ 0, 0, 255, "blue1",
+ 0, 0, 238, "blue2",
+ 0, 0, 205, "blue3",
+ 0, 0, 139, "blue4",
+ 30, 144, 255, "DodgerBlue1",
+ 28, 134, 238, "DodgerBlue2",
+ 24, 116, 205, "DodgerBlue3",
+ 16, 78, 139, "DodgerBlue4",
+ 99, 184, 255, "SteelBlue1",
+ 92, 172, 238, "SteelBlue2",
+ 79, 148, 205, "SteelBlue3",
+ 54, 100, 139, "SteelBlue4",
+ 0, 191, 255, "DeepSkyBlue1",
+ 0, 178, 238, "DeepSkyBlue2",
+ 0, 154, 205, "DeepSkyBlue3",
+ 0, 104, 139, "DeepSkyBlue4",
+ 135, 206, 255, "SkyBlue1",
+ 126, 192, 238, "SkyBlue2",
+ 108, 166, 205, "SkyBlue3",
+ 74, 112, 139, "SkyBlue4",
+ 176, 226, 255, "LightSkyBlue1",
+ 164, 211, 238, "LightSkyBlue2",
+ 141, 182, 205, "LightSkyBlue3",
+ 96, 123, 139, "LightSkyBlue4",
+ 198, 226, 255, "SlateGray1",
+ 185, 211, 238, "SlateGray2",
+ 159, 182, 205, "SlateGray3",
+ 108, 123, 139, "SlateGray4",
+ 202, 225, 255, "LightSteelBlue1",
+ 188, 210, 238, "LightSteelBlue2",
+ 162, 181, 205, "LightSteelBlue3",
+ 110, 123, 139, "LightSteelBlue4",
+ 191, 239, 255, "LightBlue1",
+ 178, 223, 238, "LightBlue2",
+ 154, 192, 205, "LightBlue3",
+ 104, 131, 139, "LightBlue4",
+ 224, 255, 255, "LightCyan1",
+ 209, 238, 238, "LightCyan2",
+ 180, 205, 205, "LightCyan3",
+ 122, 139, 139, "LightCyan4",
+ 187, 255, 255, "PaleTurquoise1",
+ 174, 238, 238, "PaleTurquoise2",
+ 150, 205, 205, "PaleTurquoise3",
+ 102, 139, 139, "PaleTurquoise4",
+ 152, 245, 255, "CadetBlue1",
+ 142, 229, 238, "CadetBlue2",
+ 122, 197, 205, "CadetBlue3",
+ 83, 134, 139, "CadetBlue4",
+ 0, 245, 255, "turquoise1",
+ 0, 229, 238, "turquoise2",
+ 0, 197, 205, "turquoise3",
+ 0, 134, 139, "turquoise4",
+ 0, 255, 255, "cyan1",
+ 0, 238, 238, "cyan2",
+ 0, 205, 205, "cyan3",
+ 0, 139, 139, "cyan4",
+ 151, 255, 255, "DarkSlateGray1",
+ 141, 238, 238, "DarkSlateGray2",
+ 121, 205, 205, "DarkSlateGray3",
+ 82, 139, 139, "DarkSlateGray4",
+ 127, 255, 212, "aquamarine1",
+ 118, 238, 198, "aquamarine2",
+ 102, 205, 170, "aquamarine3",
+ 69, 139, 116, "aquamarine4",
+ 193, 255, 193, "DarkSeaGreen1",
+ 180, 238, 180, "DarkSeaGreen2",
+ 155, 205, 155, "DarkSeaGreen3",
+ 105, 139, 105, "DarkSeaGreen4",
+ 84, 255, 159, "SeaGreen1",
+ 78, 238, 148, "SeaGreen2",
+ 67, 205, 128, "SeaGreen3",
+ 46, 139, 87, "SeaGreen4",
+ 154, 255, 154, "PaleGreen1",
+ 144, 238, 144, "PaleGreen2",
+ 124, 205, 124, "PaleGreen3",
+ 84, 139, 84, "PaleGreen4",
+ 0, 255, 127, "SpringGreen1",
+ 0, 238, 118, "SpringGreen2",
+ 0, 205, 102, "SpringGreen3",
+ 0, 139, 69, "SpringGreen4",
+ 0, 255, 0, "green1",
+ 0, 238, 0, "green2",
+ 0, 205, 0, "green3",
+ 0, 139, 0, "green4",
+ 127, 255, 0, "chartreuse1",
+ 118, 238, 0, "chartreuse2",
+ 102, 205, 0, "chartreuse3",
+ 69, 139, 0, "chartreuse4",
+ 192, 255, 62, "OliveDrab1",
+ 179, 238, 58, "OliveDrab2",
+ 154, 205, 50, "OliveDrab3",
+ 105, 139, 34, "OliveDrab4",
+ 202, 255, 112, "DarkOliveGreen1",
+ 188, 238, 104, "DarkOliveGreen2",
+ 162, 205, 90, "DarkOliveGreen3",
+ 110, 139, 61, "DarkOliveGreen4",
+ 255, 246, 143, "khaki1",
+ 238, 230, 133, "khaki2",
+ 205, 198, 115, "khaki3",
+ 139, 134, 78, "khaki4",
+ 255, 236, 139, "LightGoldenrod1",
+ 238, 220, 130, "LightGoldenrod2",
+ 205, 190, 112, "LightGoldenrod3",
+ 139, 129, 76, "LightGoldenrod4",
+ 255, 255, 224, "LightYellow1",
+ 238, 238, 209, "LightYellow2",
+ 205, 205, 180, "LightYellow3",
+ 139, 139, 122, "LightYellow4",
+ 255, 255, 0, "yellow1",
+ 238, 238, 0, "yellow2",
+ 205, 205, 0, "yellow3",
+ 139, 139, 0, "yellow4",
+ 255, 215, 0, "gold1",
+ 238, 201, 0, "gold2",
+ 205, 173, 0, "gold3",
+ 139, 117, 0, "gold4",
+ 255, 193, 37, "goldenrod1",
+ 238, 180, 34, "goldenrod2",
+ 205, 155, 29, "goldenrod3",
+ 139, 105, 20, "goldenrod4",
+ 255, 185, 15, "DarkGoldenrod1",
+ 238, 173, 14, "DarkGoldenrod2",
+ 205, 149, 12, "DarkGoldenrod3",
+ 139, 101, 8, "DarkGoldenrod4",
+ 255, 193, 193, "RosyBrown1",
+ 238, 180, 180, "RosyBrown2",
+ 205, 155, 155, "RosyBrown3",
+ 139, 105, 105, "RosyBrown4",
+ 255, 106, 106, "IndianRed1",
+ 238, 99, 99, "IndianRed2",
+ 205, 85, 85, "IndianRed3",
+ 139, 58, 58, "IndianRed4",
+ 255, 130, 71, "sienna1",
+ 238, 121, 66, "sienna2",
+ 205, 104, 57, "sienna3",
+ 139, 71, 38, "sienna4",
+ 255, 211, 155, "burlywood1",
+ 238, 197, 145, "burlywood2",
+ 205, 170, 125, "burlywood3",
+ 139, 115, 85, "burlywood4",
+ 255, 231, 186, "wheat1",
+ 238, 216, 174, "wheat2",
+ 205, 186, 150, "wheat3",
+ 139, 126, 102, "wheat4",
+ 255, 165, 79, "tan1",
+ 238, 154, 73, "tan2",
+ 205, 133, 63, "tan3",
+ 139, 90, 43, "tan4",
+ 255, 127, 36, "chocolate1",
+ 238, 118, 33, "chocolate2",
+ 205, 102, 29, "chocolate3",
+ 139, 69, 19, "chocolate4",
+ 255, 48, 48, "firebrick1",
+ 238, 44, 44, "firebrick2",
+ 205, 38, 38, "firebrick3",
+ 139, 26, 26, "firebrick4",
+ 255, 64, 64, "brown1",
+ 238, 59, 59, "brown2",
+ 205, 51, 51, "brown3",
+ 139, 35, 35, "brown4",
+ 255, 140, 105, "salmon1",
+ 238, 130, 98, "salmon2",
+ 205, 112, 84, "salmon3",
+ 139, 76, 57, "salmon4",
+ 255, 160, 122, "LightSalmon1",
+ 238, 149, 114, "LightSalmon2",
+ 205, 129, 98, "LightSalmon3",
+ 139, 87, 66, "LightSalmon4",
+ 255, 165, 0, "orange1",
+ 238, 154, 0, "orange2",
+ 205, 133, 0, "orange3",
+ 139, 90, 0, "orange4",
+ 255, 127, 0, "DarkOrange1",
+ 238, 118, 0, "DarkOrange2",
+ 205, 102, 0, "DarkOrange3",
+ 139, 69, 0, "DarkOrange4",
+ 255, 114, 86, "coral1",
+ 238, 106, 80, "coral2",
+ 205, 91, 69, "coral3",
+ 139, 62, 47, "coral4",
+ 255, 99, 71, "tomato1",
+ 238, 92, 66, "tomato2",
+ 205, 79, 57, "tomato3",
+ 139, 54, 38, "tomato4",
+ 255, 69, 0, "OrangeRed1",
+ 238, 64, 0, "OrangeRed2",
+ 205, 55, 0, "OrangeRed3",
+ 139, 37, 0, "OrangeRed4",
+ 255, 0, 0, "red1",
+ 238, 0, 0, "red2",
+ 205, 0, 0, "red3",
+ 139, 0, 0, "red4",
+ 255, 20, 147, "DeepPink1",
+ 238, 18, 137, "DeepPink2",
+ 205, 16, 118, "DeepPink3",
+ 139, 10, 80, "DeepPink4",
+ 255, 110, 180, "HotPink1",
+ 238, 106, 167, "HotPink2",
+ 205, 96, 144, "HotPink3",
+ 139, 58, 98, "HotPink4",
+ 255, 181, 197, "pink1",
+ 238, 169, 184, "pink2",
+ 205, 145, 158, "pink3",
+ 139, 99, 108, "pink4",
+ 255, 174, 185, "LightPink1",
+ 238, 162, 173, "LightPink2",
+ 205, 140, 149, "LightPink3",
+ 139, 95, 101, "LightPink4",
+ 255, 130, 171, "PaleVioletRed1",
+ 238, 121, 159, "PaleVioletRed2",
+ 205, 104, 137, "PaleVioletRed3",
+ 139, 71, 93, "PaleVioletRed4",
+ 255, 52, 179, "maroon1",
+ 238, 48, 167, "maroon2",
+ 205, 41, 144, "maroon3",
+ 139, 28, 98, "maroon4",
+ 255, 62, 150, "VioletRed1",
+ 238, 58, 140, "VioletRed2",
+ 205, 50, 120, "VioletRed3",
+ 139, 34, 82, "VioletRed4",
+ 255, 0, 255, "magenta1",
+ 238, 0, 238, "magenta2",
+ 205, 0, 205, "magenta3",
+ 139, 0, 139, "magenta4",
+ 255, 131, 250, "orchid1",
+ 238, 122, 233, "orchid2",
+ 205, 105, 201, "orchid3",
+ 139, 71, 137, "orchid4",
+ 255, 187, 255, "plum1",
+ 238, 174, 238, "plum2",
+ 205, 150, 205, "plum3",
+ 139, 102, 139, "plum4",
+ 224, 102, 255, "MediumOrchid1",
+ 209, 95, 238, "MediumOrchid2",
+ 180, 82, 205, "MediumOrchid3",
+ 122, 55, 139, "MediumOrchid4",
+ 191, 62, 255, "DarkOrchid1",
+ 178, 58, 238, "DarkOrchid2",
+ 154, 50, 205, "DarkOrchid3",
+ 104, 34, 139, "DarkOrchid4",
+ 155, 48, 255, "purple1",
+ 145, 44, 238, "purple2",
+ 125, 38, 205, "purple3",
+ 85, 26, 139, "purple4",
+ 171, 130, 255, "MediumPurple1",
+ 159, 121, 238, "MediumPurple2",
+ 137, 104, 205, "MediumPurple3",
+ 93, 71, 139, "MediumPurple4",
+ 255, 225, 255, "thistle1",
+ 238, 210, 238, "thistle2",
+ 205, 181, 205, "thistle3",
+ 139, 123, 139, "thistle4",
+ 0, 0, 0, "gray0",
+ 0, 0, 0, "grey0",
+ 3, 3, 3, "gray1",
+ 3, 3, 3, "grey1",
+ 5, 5, 5, "gray2",
+ 5, 5, 5, "grey2",
+ 8, 8, 8, "gray3",
+ 8, 8, 8, "grey3",
+ 10, 10, 10, "gray4",
+ 10, 10, 10, "grey4",
+ 13, 13, 13, "gray5",
+ 13, 13, 13, "grey5",
+ 15, 15, 15, "gray6",
+ 15, 15, 15, "grey6",
+ 18, 18, 18, "gray7",
+ 18, 18, 18, "grey7",
+ 20, 20, 20, "gray8",
+ 20, 20, 20, "grey8",
+ 23, 23, 23, "gray9",
+ 23, 23, 23, "grey9",
+ 26, 26, 26, "gray10",
+ 26, 26, 26, "grey10",
+ 28, 28, 28, "gray11",
+ 28, 28, 28, "grey11",
+ 31, 31, 31, "gray12",
+ 31, 31, 31, "grey12",
+ 33, 33, 33, "gray13",
+ 33, 33, 33, "grey13",
+ 36, 36, 36, "gray14",
+ 36, 36, 36, "grey14",
+ 38, 38, 38, "gray15",
+ 38, 38, 38, "grey15",
+ 41, 41, 41, "gray16",
+ 41, 41, 41, "grey16",
+ 43, 43, 43, "gray17",
+ 43, 43, 43, "grey17",
+ 46, 46, 46, "gray18",
+ 46, 46, 46, "grey18",
+ 48, 48, 48, "gray19",
+ 48, 48, 48, "grey19",
+ 51, 51, 51, "gray20",
+ 51, 51, 51, "grey20",
+ 54, 54, 54, "gray21",
+ 54, 54, 54, "grey21",
+ 56, 56, 56, "gray22",
+ 56, 56, 56, "grey22",
+ 59, 59, 59, "gray23",
+ 59, 59, 59, "grey23",
+ 61, 61, 61, "gray24",
+ 61, 61, 61, "grey24",
+ 64, 64, 64, "gray25",
+ 64, 64, 64, "grey25",
+ 66, 66, 66, "gray26",
+ 66, 66, 66, "grey26",
+ 69, 69, 69, "gray27",
+ 69, 69, 69, "grey27",
+ 71, 71, 71, "gray28",
+ 71, 71, 71, "grey28",
+ 74, 74, 74, "gray29",
+ 74, 74, 74, "grey29",
+ 77, 77, 77, "gray30",
+ 77, 77, 77, "grey30",
+ 79, 79, 79, "gray31",
+ 79, 79, 79, "grey31",
+ 82, 82, 82, "gray32",
+ 82, 82, 82, "grey32",
+ 84, 84, 84, "gray33",
+ 84, 84, 84, "grey33",
+ 87, 87, 87, "gray34",
+ 87, 87, 87, "grey34",
+ 89, 89, 89, "gray35",
+ 89, 89, 89, "grey35",
+ 92, 92, 92, "gray36",
+ 92, 92, 92, "grey36",
+ 94, 94, 94, "gray37",
+ 94, 94, 94, "grey37",
+ 97, 97, 97, "gray38",
+ 97, 97, 97, "grey38",
+ 99, 99, 99, "gray39",
+ 99, 99, 99, "grey39",
+ 102, 102, 102, "gray40",
+ 102, 102, 102, "grey40",
+ 105, 105, 105, "gray41",
+ 105, 105, 105, "grey41",
+ 107, 107, 107, "gray42",
+ 107, 107, 107, "grey42",
+ 110, 110, 110, "gray43",
+ 110, 110, 110, "grey43",
+ 112, 112, 112, "gray44",
+ 112, 112, 112, "grey44",
+ 115, 115, 115, "gray45",
+ 115, 115, 115, "grey45",
+ 117, 117, 117, "gray46",
+ 117, 117, 117, "grey46",
+ 120, 120, 120, "gray47",
+ 120, 120, 120, "grey47",
+ 122, 122, 122, "gray48",
+ 122, 122, 122, "grey48",
+ 125, 125, 125, "gray49",
+ 125, 125, 125, "grey49",
+ 127, 127, 127, "gray50",
+ 127, 127, 127, "grey50",
+ 130, 130, 130, "gray51",
+ 130, 130, 130, "grey51",
+ 133, 133, 133, "gray52",
+ 133, 133, 133, "grey52",
+ 135, 135, 135, "gray53",
+ 135, 135, 135, "grey53",
+ 138, 138, 138, "gray54",
+ 138, 138, 138, "grey54",
+ 140, 140, 140, "gray55",
+ 140, 140, 140, "grey55",
+ 143, 143, 143, "gray56",
+ 143, 143, 143, "grey56",
+ 145, 145, 145, "gray57",
+ 145, 145, 145, "grey57",
+ 148, 148, 148, "gray58",
+ 148, 148, 148, "grey58",
+ 150, 150, 150, "gray59",
+ 150, 150, 150, "grey59",
+ 153, 153, 153, "gray60",
+ 153, 153, 153, "grey60",
+ 156, 156, 156, "gray61",
+ 156, 156, 156, "grey61",
+ 158, 158, 158, "gray62",
+ 158, 158, 158, "grey62",
+ 161, 161, 161, "gray63",
+ 161, 161, 161, "grey63",
+ 163, 163, 163, "gray64",
+ 163, 163, 163, "grey64",
+ 166, 166, 166, "gray65",
+ 166, 166, 166, "grey65",
+ 168, 168, 168, "gray66",
+ 168, 168, 168, "grey66",
+ 171, 171, 171, "gray67",
+ 171, 171, 171, "grey67",
+ 173, 173, 173, "gray68",
+ 173, 173, 173, "grey68",
+ 176, 176, 176, "gray69",
+ 176, 176, 176, "grey69",
+ 179, 179, 179, "gray70",
+ 179, 179, 179, "grey70",
+ 181, 181, 181, "gray71",
+ 181, 181, 181, "grey71",
+ 184, 184, 184, "gray72",
+ 184, 184, 184, "grey72",
+ 186, 186, 186, "gray73",
+ 186, 186, 186, "grey73",
+ 189, 189, 189, "gray74",
+ 189, 189, 189, "grey74",
+ 191, 191, 191, "gray75",
+ 191, 191, 191, "grey75",
+ 194, 194, 194, "gray76",
+ 194, 194, 194, "grey76",
+ 196, 196, 196, "gray77",
+ 196, 196, 196, "grey77",
+ 199, 199, 199, "gray78",
+ 199, 199, 199, "grey78",
+ 201, 201, 201, "gray79",
+ 201, 201, 201, "grey79",
+ 204, 204, 204, "gray80",
+ 204, 204, 204, "grey80",
+ 207, 207, 207, "gray81",
+ 207, 207, 207, "grey81",
+ 209, 209, 209, "gray82",
+ 209, 209, 209, "grey82",
+ 212, 212, 212, "gray83",
+ 212, 212, 212, "grey83",
+ 214, 214, 214, "gray84",
+ 214, 214, 214, "grey84",
+ 217, 217, 217, "gray85",
+ 217, 217, 217, "grey85",
+ 219, 219, 219, "gray86",
+ 219, 219, 219, "grey86",
+ 222, 222, 222, "gray87",
+ 222, 222, 222, "grey87",
+ 224, 224, 224, "gray88",
+ 224, 224, 224, "grey88",
+ 227, 227, 227, "gray89",
+ 227, 227, 227, "grey89",
+ 229, 229, 229, "gray90",
+ 229, 229, 229, "grey90",
+ 232, 232, 232, "gray91",
+ 232, 232, 232, "grey91",
+ 235, 235, 235, "gray92",
+ 235, 235, 235, "grey92",
+ 237, 237, 237, "gray93",
+ 237, 237, 237, "grey93",
+ 240, 240, 240, "gray94",
+ 240, 240, 240, "grey94",
+ 242, 242, 242, "gray95",
+ 242, 242, 242, "grey95",
+ 245, 245, 245, "gray96",
+ 245, 245, 245, "grey96",
+ 247, 247, 247, "gray97",
+ 247, 247, 247, "grey97",
+ 250, 250, 250, "gray98",
+ 250, 250, 250, "grey98",
+ 252, 252, 252, "gray99",
+ 252, 252, 252, "grey99",
+ 255, 255, 255, "gray100",
+ 255, 255, 255, "grey100",
+ 0, 0, 0, NULL
+};
+
+#endif /* _XCOLORS */
diff --git a/tk/xlib/xdraw.c b/tk/xlib/xdraw.c
index 2655915b3c2..05738d068b4 100644
--- a/tk/xlib/xdraw.c
+++ b/tk/xlib/xdraw.c
@@ -80,3 +80,4 @@ XFillRectangle(display, d, gc, x, y, width, height)
rectangle.height = height;
XFillRectangles(display, d, gc, &rectangle, 1);
}
+
diff --git a/tk/xlib/xgc.c b/tk/xlib/xgc.c
index 90c44e1ead1..f40ebc4197b 100644
--- a/tk/xlib/xgc.c
+++ b/tk/xlib/xgc.c
@@ -16,6 +16,9 @@
#ifdef MAC_TCL
# include <Xlib.h>
+# include <X.h>
+# define Cursor XCursor
+# define Region XRegion
#else
# include <X11/Xlib.h>
#endif
@@ -46,7 +49,15 @@ XCreateGC(display, d, mask, values)
{
GC gp;
- gp = (XGCValues *)ckalloc(sizeof(XGCValues));
+/*
+ * 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;
}
@@ -73,6 +84,7 @@ XCreateGC(display, d, mask, values)
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));
@@ -131,7 +143,7 @@ XChangeGC(d, gc, mask, values)
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; }
+ if (mask & GCDashList) { gc->dashes = values->dashes; (&(gc->dashes))[1] = 0;}
}
/*
@@ -150,8 +162,7 @@ XChangeGC(d, gc, mask, values)
*----------------------------------------------------------------------
*/
-void
-XFreeGC(d, gc)
+void XFreeGC(d, gc)
Display * d;
GC gc;
{
@@ -199,6 +210,30 @@ XSetBackground(display, gc, 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;
@@ -351,3 +386,160 @@ XSetClipMask(display, gc, pixmap)
((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);
+ }
+}
+
+#ifndef MAC_TCL
+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/tk/xlib/ximage.c b/tk/xlib/ximage.c
index 2b0d588b800..512302e4ed0 100644
--- a/tk/xlib/ximage.c
+++ b/tk/xlib/ximage.c
@@ -69,3 +69,4 @@ XCreateBitmapFromData(display, d, data, width, height)
XFreeGC(display, gc);
return pix;
}
+
diff --git a/tk/xlib/xutil.c b/tk/xlib/xutil.c
index b98a6fdd48c..2ddbad6dba8 100644
--- a/tk/xlib/xutil.c
+++ b/tk/xlib/xutil.c
@@ -114,3 +114,4 @@ XGetVisualInfo(display, vinfo_mask, vinfo_template, nitems_return)
*nitems_return = 1;
return info;
}
+